Implementation of SEIAR and SEPIAR Model
Rahul Subramanian
April 12, 2020
#Load Libraries
rm(list = ls())
library(plyr)
library(tidyverse)## ── Attaching packages ────────────────────────────────── tidyverse 1.2.1 ──## ✓ ggplot2 3.3.2 ✓ purrr 0.3.3
## ✓ tibble 2.1.3 ✓ dplyr 0.8.5
## ✓ tidyr 1.0.2 ✓ stringr 1.4.0
## ✓ readr 1.3.1 ✓ forcats 0.4.0## Warning: package 'tibble' was built under R version 3.5.2## Warning: package 'tidyr' was built under R version 3.5.2## Warning: package 'purrr' was built under R version 3.5.2## Warning: package 'dplyr' was built under R version 3.5.2## Warning: package 'stringr' was built under R version 3.5.2## Warning: package 'forcats' was built under R version 3.5.2## ── Conflicts ───────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::arrange() masks plyr::arrange()
## x purrr::compact() masks plyr::compact()
## x dplyr::count() masks plyr::count()
## x dplyr::failwith() masks plyr::failwith()
## x dplyr::filter() masks stats::filter()
## x dplyr::id() masks plyr::id()
## x dplyr::lag() masks stats::lag()
## x dplyr::mutate() masks plyr::mutate()
## x dplyr::rename() masks plyr::rename()
## x dplyr::summarise() masks plyr::summarise()
## x dplyr::summarize() masks plyr::summarize()library(magrittr)##
## Attaching package: 'magrittr'## The following object is masked from 'package:purrr':
##
## set_names## The following object is masked from 'package:tidyr':
##
## extractlibrary(tibble)
library(stringi)## Warning: package 'stringi' was built under R version 3.5.2library(pomp)## Warning: package 'pomp' was built under R version 3.5.2## Welcome to pomp version 2!
## For information on upgrading your pomp version < 2 code, see the
## 'pomp version 2 upgrade guide' at https://kingaa.github.io/pomp/.##
## Attaching package: 'pomp'## The following object is masked from 'package:purrr':
##
## maplibrary(xtable)## Warning: package 'xtable' was built under R version 3.5.2#library(panelPomp)
#library(foreach)
#library(iterators)
#library(doRNG)
#library(aakmisc) ## available at https://kingaa.github.io/
stopifnot(packageVersion("pomp")>="2.2")
#stopifnot(packageVersion("panelPomp")>="0.9.1")
#stopifnot(packageVersion("aakmisc")>="0.26.2")
options(
stringsAsFactors=FALSE,
keep.source=TRUE,
encoding="UTF-8"
)
set.seed(407958184)Load essential libraries and plot themes
source("load_libraries_essential.R")
source("rahul_theme.R")
library(zoo)## Warning: package 'zoo' was built under R version 3.5.2##
## Attaching package: 'zoo'## The following object is masked from 'package:pomp':
##
## time<-## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(stringr)See the SI_Appendix for model equations.
Declare model name
full_model_name = "NYC_Covid_Model_Hyrbid_Model_1_Pre-Symp_Compartment_Set_b_p_to_0"
model_name = "N_12"
rda_index = 0
rds_index = 0Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14Load data and covariates for model
Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")Load COVID testing data
NYC_full_testing_data = read.csv("../Generated_Data/NYC_full_testing_data.csv")
head(NYC_full_testing_data)## Test.Date New_Positives Cumulative_Number_of_Positives
## 1 03/02/2020 0 0
## 2 03/03/2020 0 0
## 3 03/04/2020 2 2
## 4 03/05/2020 2 4
## 5 03/06/2020 7 11
## 6 03/07/2020 0 11
## Total_Number_of_Tests_Performed Cumulative_Number_of_Tests_Performed
## 1 0 0
## 2 8 8
## 3 8 16
## 4 36 52
## 5 45 97
## 6 64 161
## Prop_Pos Not_Pos Date
## 1 NA 0 2020-03-02
## 2 0.00000000 8 2020-03-03
## 3 0.25000000 6 2020-03-04
## 4 0.05555556 34 2020-03-05
## 5 0.15555556 38 2020-03-06
## 6 0.00000000 64 2020-03-07Observed_data = NYC_full_testing_data %>%
mutate(times = as.numeric(as.Date(Date) - true_start_date)) %>%
select(Y = New_Positives, times,
obs_prop_positive = Prop_Pos)
Observed_data = Observed_data %>%
filter(times < 90)
head(Observed_data)## Y times obs_prop_positive
## 1 0 1 NA
## 2 0 2 0.00000000
## 3 2 3 0.25000000
## 4 2 4 0.05555556
## 5 7 5 0.15555556
## 6 0 6 0.00000000write.csv(Observed_data,
file = paste0("../Generated_Data/observed_data_", model_name, ".csv"),
row.names = FALSE)Load in testing data covariates
testing_data = NYC_full_testing_data %>%
select(L = Total_Number_of_Tests_Performed, Date)
orig_testing_df = testing_data %>%
mutate(times = as.numeric(as.Date(Date) - true_start_date)) %>%
dplyr::select(times,L_orig = L)
testing_data = testing_data %>%
mutate(Adj_Date = as.Date(Date) -2) %>%
mutate(times = as.numeric(Adj_Date - true_start_date)) %>%
mutate(Week = (ceiling(as.numeric(Adj_Date - first_saturday_in_year)/7)) + 1,
Year = year(Adj_Date)) %>%
dplyr::select(times,L_advanced_2_days = L, Week, Year)
testing_data = join(testing_data, orig_testing_df)## Joining by: times # Assign 0 to start date orig testing
testing_data$L_orig[1] = 0
testing_data$L_orig[2] = 0Load in Flu data
NYC_region_confirmed_flucases_NY_state_2020 = read.csv(
file = "../Generated_Data/NYC_region_confirmed_flucases_NY_state_2020.csv")
NYC_flu_data = NYC_region_confirmed_flucases_NY_state_2020 %>%
dplyr::select(Week = Week, Year = Year, F_w_y = Confirmed_Flu_Cases)Adjust-assume that 0 cases were reported in later weeks (when surveillance was halted).
flu_data_missing_weeks = data.frame(Week = seq(from = max(NYC_flu_data$Week) +1,
to = max(testing_data$Week) +1),
Year = 2020,
F_w_y = 0)
NYC_flu_data_adj = rbind(NYC_flu_data,
flu_data_missing_weeks)Assemble covariate data frame
covariate_df = join(testing_data,
NYC_flu_data_adj,
by = c("Week", "Year"))
head(covariate_df)## times L_advanced_2_days Week Year L_orig F_w_y
## 1 -1 0 9 2020 0 2700
## 2 0 8 10 2020 0 2413
## 3 1 8 10 2020 0 2413
## 4 2 36 10 2020 8 2413
## 5 3 45 10 2020 8 2413
## 6 4 64 10 2020 36 2413write.csv(covariate_df,
file = paste0("../Generated_Data/covariate_data_", model_name, ".csv"),
row.names = FALSE)Create covariate table
# ---- covar ----
covar=covariate_table(
time=covariate_df$times,
L_advanced_2_days=covariate_df$L_advanced_2_days,
L_orig = covariate_df$L_orig,
F_w_y = covariate_df$F_w_y,
w = covariate_df$Week,
y = covariate_df$Year,
times="time"
)fitted_NC_model_params = read.csv(
file = "../Generated_Data/fitted_NC_model_params.csv")
g_F = fitted_NC_model_params$g_F/7
g_0 = fitted_NC_model_params$g_0/7
beta_w_3 = fitted_NC_model_params$Beta_w_3/7
beta_w_2 = fitted_NC_model_params$Beta_w_2/7
beta_w_1 = fitted_NC_model_params$Beta_w_1/7
beta_w_0 = fitted_NC_model_params$Beta_w_0/7
sigma_epsilon = fitted_NC_model_params$sigma_epsilon/7
g_F## [1] 0.1162005g_0## [1] 1183.3beta_w_3## [1] 0.01215073beta_w_2## [1] 0.9810086beta_w_1## [1] -37.23481beta_w_0## [1] 229.4094sigma_epsilon## [1] 109.1121fitted_NC_model_params = data.frame(g_F = g_F, g_0 =g_0, beta_w_2 = beta_w_2,
beta_w_1 = beta_w_1,
beta_w_0 = beta_w_0,
sigma_epsilon = sigma_epsilon)Build Model
POMP Csnippet
Process model
#Process model Csnippet with queue incorporated
rproc <- Csnippet("
//Declare Arrays
double rate_I_P[2], trans_I_P[2]; //Declare arrays for eulermultinom transitions from Exposed Compartment
double rate_I_S_1[2], trans_I_S_1[2]; //Declare arrays for eulermultinom transitions from symptomatic infection Compartment
double multinom_output[8], multinom_prob[8]; //Declare arrays for multinom in Q5
int M = (int) M_0; //Number of exposed compartments
int V = (int) V_0; //Number of days spent in hospital (number of cohorts in Queues 1 and NC)
int K = (int) K_0; //Number of days spent in quarantine (number of cohorts in Queue 3)
int m; //Exposed compartment number
int v; //Queue 1/ Queue NC cohort number
int k; //Queue 3 cohort number
double dE_m_E_m_1[M-1]; //Declare array for binomial transitions between Exposed Compartments
double P_Q1_old[V]; //Declare array to store old value of P_Q1 during capacity calculations.
double P_Q3_old[K]; //Declare array to store old value of P_Q3 during capacity calculations.
double QNC_old[V]; //Declare array to store old value of QNC during capacity calculations.
double Q1_old[V]; //Declare array to store old value of Q1 during capacity calculations.
double Q3_old[K]; //Declare array to store old value of Q3 during capacity calculations.
//Declare E pointer array
double *e=&E_1;
//Declare Queue 1 pointer arrays
double *q_1=&Q_1_1;
double *p_q1=&P_Q1_1;
double *total_samples_for_PCR_Testing_q1=&total_samples_for_PCR_Testing_Q1_1;
double *total_samples_for_PCR_Testing_lag_1_q1=&total_samples_for_PCR_Testing_lag_1_Q1_1;
double *total_samples_for_PCR_Testing_lag_2_q1=&total_samples_for_PCR_Testing_lag_2_Q1_1;
double *y_q1=&Y_Q1_1;
//Declare Queue NC pointer arrays
double *q_nc=&Q_NC_1;
double *total_samples_for_PCR_Testing_qnc=&total_samples_for_PCR_Testing_QNC_1;
double *total_samples_for_PCR_Testing_lag_1_qnc=&total_samples_for_PCR_Testing_lag_1_QNC_1;
double *total_samples_for_PCR_Testing_lag_2_qnc=&total_samples_for_PCR_Testing_lag_2_QNC_1;
double *y_qnc=&Y_QNC_1;
//Declare Queue 3 pointer arrays
double *q_3=&Q_3_1;
double *p_q3=&P_Q3_1;
double *total_samples_for_PCR_Testing_q3=&total_samples_for_PCR_Testing_Q3_1;
double *total_samples_for_PCR_Testing_lag_1_q3=&total_samples_for_PCR_Testing_lag_1_Q3_1;
double *total_samples_for_PCR_Testing_lag_2_q3=&total_samples_for_PCR_Testing_lag_2_Q3_1;
double *y_q3=&Y_Q3_1;
//Error checks- Top of model
if(R_A < 0 || R_F < 0 || R_H < 0 || I_A < 0 || I_P < 0 || I_H < 0 || I_S_1 < 0 || I_S_2 < 0 || S < 0 || N < 0 || Backlog_Queue_1 < 0 || Q_2 < 0 ||Backlog_Queue_3 < 0 || Q_4 < 0 |Backlog_Queue_NC < 0|| First_re_test_Q1 < 0 || Second_re_test_Q1 < 0 || First_re_test_Q3 < 0 || Second_re_test_Q3 < 0 || total_samples_for_PCR_Testing_backlog_Q1 < 0 || total_samples_for_PCR_Testing_backlog_lag_1_Q1 < 0 || total_samples_for_PCR_Testing_backlog_lag_2_Q1 < 0 || total_samples_for_PCR_Testing_backlog_Q3 < 0 || total_samples_for_PCR_Testing_backlog_lag_1_Q3 < 0 || total_samples_for_PCR_Testing_backlog_lag_2_Q3 < 0 ||total_samples_for_PCR_Testing_backlog_QNC < 0 || total_samples_for_PCR_Testing_backlog_lag_1_QNC < 0 || total_samples_for_PCR_Testing_backlog_lag_2_QNC < 0 || neg_samples_Q1 < 0 || neg_samples_Q3 < 0 || total_neg_samples_all_queues < 0 || L_advanced_2_days < 0 || G_w_y < 0 || L_int < 0 || F_w_y < 0 || L_1 < 0 || w < 0 || L_2 < 0 || L_3 < 0 || L_4 < 0 || y < 0){
Neg_State_Value_Detected = TRUE;
Rprintf(\"Negative state variable detected at top of process model t = %lg \\n\", t);
}
double sum_everything = R_A + R_F + R_H + I_P + I_A + I_H + I_S_1 + I_S_2 + S + N;
sum_everything = sum_everything + Backlog_Queue_1 + Backlog_Queue_3 + Backlog_Queue_NC + Q_2 + Q_4;
sum_everything = sum_everything + First_re_test_Q1 + First_re_test_Q3 +Second_re_test_Q1 + Second_re_test_Q3;
sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_Q1 + total_samples_for_PCR_Testing_backlog_Q3 + total_samples_for_PCR_Testing_backlog_QNC;
sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_lag_1_Q1 + total_samples_for_PCR_Testing_backlog_lag_1_Q3 + total_samples_for_PCR_Testing_backlog_lag_1_QNC;
sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_lag_2_Q1 + total_samples_for_PCR_Testing_backlog_lag_2_Q3 + total_samples_for_PCR_Testing_backlog_lag_2_QNC;
sum_everything = sum_everything + neg_samples_Q1 + neg_samples_Q3 + total_neg_samples_all_queues;
sum_everything = sum_everything + L_advanced_2_days + G_w_y + F_w_y + L_int + L_1 + L_2 + L_3 + L_4 + w + y;
if(isnan(sum_everything)){
NAN_State_Value_Detected = TRUE;
Rprintf(\"nan state variable detected at top of process model t = %lg \\n\", t);
}
//Check Exposed Compartments
for(m=0; m<M; m++) {
if(isnan(e[m])){
NAN_State_Value_Detected = TRUE;
Rprintf(\"nan state variable detected at top of process model t = %lg \\n\", t);
}
if(e[m] < 0) {
Neg_State_Value_Detected = TRUE;
Rprintf(\"Negative state variable detected at top of process model t = %lg \\n\", t);
}
}
//Check Q_1 and Q_NC arrays
for(v=0; v<V; v++) {
if(isnan(q_1[v]) || isnan(q_nc[v]) || isnan(p_q1[v]) || isnan(total_samples_for_PCR_Testing_q1[v]) || isnan(total_samples_for_PCR_Testing_qnc[v]) || isnan(total_samples_for_PCR_Testing_lag_1_q1[v]) || isnan(total_samples_for_PCR_Testing_lag_1_qnc[v]) || isnan(total_samples_for_PCR_Testing_lag_2_q1[v]) || isnan(total_samples_for_PCR_Testing_lag_2_qnc[v])){
NAN_State_Value_Detected = TRUE;
Rprintf(\"nan state variable detected at top of process model t = %lg \\n\", t);
}
if(q_1[v] < 0 || q_nc[v] < 0 || p_q1[v] < 0 || total_samples_for_PCR_Testing_q1[v] < 0 || total_samples_for_PCR_Testing_qnc[v] < 0 || total_samples_for_PCR_Testing_lag_1_q1[v] < 0 || total_samples_for_PCR_Testing_lag_1_qnc[v] < 0 || total_samples_for_PCR_Testing_lag_2_q1[v] < 0 || total_samples_for_PCR_Testing_lag_2_qnc[v] < 0 ) {
Neg_State_Value_Detected = TRUE;
Rprintf(\"Negative state variable detected at top of process model t = %lg \\n\", t);
}
}
//Check Q_3 Arrays
for(k=0; k<K; k++) {
if(isnan(q_3[k]) || isnan(p_q3[k]) || isnan(total_samples_for_PCR_Testing_q3[k]) || isnan(total_samples_for_PCR_Testing_lag_1_q3[k]) || isnan(total_samples_for_PCR_Testing_lag_2_q3[k]) || isnan(q_3[k])){
NAN_State_Value_Detected = TRUE;
Rprintf(\"nan state variable detected at top of process model t = %lg \\n\", t);
}
if(q_3[k] < 0 || p_q3[k] < 0 || total_samples_for_PCR_Testing_q3[k] < 0 || total_samples_for_PCR_Testing_lag_1_q3[k] < 0 || total_samples_for_PCR_Testing_lag_2_q3[k] < 0 ) {
Neg_State_Value_Detected = TRUE;
Rprintf(\"Negative state variable detected at top of process model t = %lg \\n\", t);
}
}
int print_out_top = (Error_Printing_Complete == FALSE) & (Neg_State_Value_Detected == TRUE || NAN_State_Value_Detected == TRUE);
if(print_out_top){
Rprintf(\"I_S_1 = %lg \\n\", I_S_1);
Rprintf(\"I_S_2 = %lg \\n\", I_S_2);
Rprintf(\"I_H = %lg \\n\", I_H);
Rprintf(\"I_P = %lg \\n\", I_P);
Rprintf(\"I_A = %lg \\n\", I_A);
Rprintf(\"Backlog_Queue_1 = %lg \\n\", Backlog_Queue_1);
Rprintf(\"Backlog_Queue_3 = %lg \\n\", Backlog_Queue_3);
Rprintf(\"Backlog_Queue_NC = %lg \\n\", Backlog_Queue_NC);
Rprintf(\"First_re_test_Q1 = %lg \\n\", First_re_test_Q1);
Rprintf(\"First_re_test_Q3 = %lg \\n\", First_re_test_Q3);
Rprintf(\"Second_re_test_Q1 = %lg \\n\", Second_re_test_Q1);
Rprintf(\"Second_re_test_Q3 = %lg \\n\", Second_re_test_Q3);
Rprintf(\"total_samples_for_PCR_Testing_backlog_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_Q1);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_Q1);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_Q1);
Rprintf(\"total_samples_for_PCR_Testing_backlog_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_Q3);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_Q3);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_Q3);
Rprintf(\"total_samples_for_PCR_Testing_backlog_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_QNC);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_QNC);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_QNC);
Rprintf(\"neg_samples_Q1 = %lg \\n\", neg_samples_Q1);
Rprintf(\"neg_samples_Q3 = %lg \\n\", neg_samples_Q3);
Rprintf(\"total_neg_samples_all_queues = %lg \\n\", total_neg_samples_all_queues);
Rprintf(\"Q_2 = %lg \\n\", Q_2);
Rprintf(\"Q_4 = %lg \\n\", Q_4);
Rprintf(\"F_w_y = %lg \\n\", F_w_y);
Rprintf(\"w = %lg \\n\", w);
Rprintf(\"y = %lg \\n\", y);
Rprintf(\"E_1 = %lg \\n\", E_1);
Rprintf(\"E_2 = %lg \\n\", E_2);
Rprintf(\"E_3 = %lg \\n\", E_3);
Rprintf(\"E_4 = %lg \\n\", E_4);
Rprintf(\"E_5 = %lg \\n\", E_5);
Rprintf(\"R_H = %lg \\n\", R_H);
Rprintf(\"R_A = %lg \\n\", R_A);
Rprintf(\"R_F = %lg \\n\", R_F);
Rprintf(\"N = %lg \\n\", N);
Rprintf(\"S = %lg \\n\", S);
Rprintf(\"L_advanced_2_days = %lg \\n\", L_advanced_2_days);
Rprintf(\"G_w_y = %lg \\n\", G_w_y);
Rprintf(\"L_int = %lg \\n\", L_int);
Rprintf(\"L_1 = %lg \\n\", L_1);
Rprintf(\"L_2 = %lg \\n\", L_2);
Rprintf(\"L_3 = %lg \\n\", L_3);
Rprintf(\"L_4 = %lg \\n\", L_4);
Rprintf(\"Print out params p_S = %lg \\n\", p_S);
Rprintf(\"p_H_cond_S = %lg \\n\", p_H_cond_S);
Rprintf(\"phi_E = %lg \\n\", phi_E);
Rprintf(\"phi_U = %lg \\n\", phi_U);
Rprintf(\"phi_S = %lg \\n\", phi_S);
Rprintf(\"h_V = %lg \\n\", h_V);
Rprintf(\"gamma = %lg \\n\", gamma);
Rprintf(\"R_0 = %lg \\n\", R_0);
Rprintf(\"b_q = %lg \\n\", b_q);
Rprintf(\"b_a = %lg \\n\", b_a);
Rprintf(\"b_p = %lg \\n\", b_p);
Rprintf(\"z_0 = %lg \\n\", z_0);
Rprintf(\"E_0 = %lg \\n\", E_0);
Rprintf(\"N_0 = %lg \\n\", N_0);
Rprintf(\"C_0 = %lg \\n\", C_0);
Rprintf(\"G_w_y_scaling = %lg \\n\", G_w_y_scaling);
Rprintf(\"quarantine_start_time = %lg \\n\", quarantine_start_time);
Rprintf(\"PCR_sens = %lg \\n\", PCR_sens);
Rprintf(\"sigma_M = %lg \\n\", sigma_M);
Rprintf(\"beta_w_3 = %lg \\n\", beta_w_3);
Rprintf(\"beta_w_2 = %lg \\n\", beta_w_2);
Rprintf(\"beta_w_1 = %lg \\n\", beta_w_1);
Rprintf(\"beta_w_0 = %lg \\n\", beta_w_0);
Rprintf(\"g_0 = %lg \\n\", g_0);
Rprintf(\"g_F = %lg \\n\", g_F);
Rprintf(\"sigma_epsilon = %lg \\n\", sigma_epsilon);
//Print out exposed compartments
for(m=0; m<M; m++) {
Rprintf(\"m = %d \\n\", m);
Rprintf(\"e[m] = %lg \\n\", e[m]);
}
//Print out Q_1 and Q_NC compartments
for(v=0; v<V; v++) {
Rprintf(\"v = %d \\n\", v);
Rprintf(\"q_1[v] = %lg \\n\", q_1[v]);
Rprintf(\"q_nc[v] = %lg \\n\", q_nc[v]);
Rprintf(\"p_q1[v] = %lg \\n\", p_q1[v]);
Rprintf(\"total_samples_for_PCR_Testing_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_q1[v]);
Rprintf(\"total_samples_for_PCR_Testing_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_qnc[v]);
Rprintf(\"total_samples_for_PCR_Testing_lag_1_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_q1[v]);
Rprintf(\"total_samples_for_PCR_Testing_lag_1_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_qnc[v]);
Rprintf(\"total_samples_for_PCR_Testing_lag_2_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_q1[v]);
Rprintf(\"total_samples_for_PCR_Testing_lag_2_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_qnc[v]);
}
//Print out Q_3 compartments
for(k=0; k<K; k++) {
Rprintf(\"k = %d \\n\", k);
Rprintf(\"q_3[k] = %lg \\n\", q_3[k]);
Rprintf(\"p_q3[k] = %lg \\n\", p_q3[k]);
Rprintf(\"total_samples_for_PCR_Testing_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_q3[k]);
Rprintf(\"total_samples_for_PCR_Testing_lag_1_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_q3[k]);
Rprintf(\"total_samples_for_PCR_Testing_lag_2_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_q3[k]);
}
Error_Printing_Complete = TRUE;
}
//Main Process Model Code Block
//Initialize transition array (make it NAN so it will trigger warnings if
//used when unchanged)
for(m=0; m<M-1; m++) {
dE_m_E_m_1[m] = NAN;
}
double total_time_infected = (1/gamma) + (1/phi_S);
double gamma_total = 1/total_time_infected;
double Beta_0 = R_0*(gamma_total);
double Beta_1 = b_q*Beta_0;
beta_t = Beta_0;
if(t > quarantine_start_time){
beta_t = Beta_1;
}else{
if(t > social_distancing_start_time){
double m_q = (Beta_1 - Beta_0)/(quarantine_start_time - social_distancing_start_time);
beta_t = Beta_0 + m_q*(t-social_distancing_start_time);
}
}
//Calculate transmssion rates in pre-symptomatic classes
double beta_p = b_p*beta_t;
//Calculate transmssion rates in asymptomatic classes
double beta_a = b_a*beta_t;
//Rates for Euler Multinom leaving Infected Pre-symptomatic class
double mu_I_P_I_A = (1-p_S)*phi_U; //Moving from I_P to I_A
double mu_I_P_I_S_1 = p_S*phi_U; //Moving from I_P to I_S_1
rate_I_P[0] = mu_I_P_I_A;
rate_I_P[1] = mu_I_P_I_S_1;
//Rates for Euler Multinom leaving Infected Symptomatic class
double mu_I_S_1_I_H = p_H_cond_S*phi_S; //Moving from I_S_1 to I_H
double mu_I_S_1_I_S_2 = (1-p_H_cond_S)*phi_S; //Moving from I_S_1 to I_S_2
rate_I_S_1[0] = mu_I_S_1_I_H;
rate_I_S_1[1] = mu_I_S_1_I_S_2;
//Calculate force of infection
double lambda_FOI = (beta_t*(I_S_1 + I_S_2) + beta_a*(I_A) + beta_p*(I_P))/N;
double mu_S_E_1 = lambda_FOI;
//Calculate rate of moving bewteen exposed compartments
double mu_E_m_E_m_1 = phi_E;
//Calculate rate of moving from Infected Asymptomatic class to
// Recovered Asymptomatic class
double mu_I_A_R_A = phi_S;
//Calculate rate of moving from last Exposed compartment to
//Infected Pre-sympatomatic class
double mu_E_M_I_P = phi_E;
//Calculate rate of moving from Infected Flu-like class to Recovered Flu-Like Class
double mu_I_S_2_R_F = gamma;
//Calculate rate of moving from Infected Hospitalized class to Recovered Hospitalized Class
double mu_I_H_R_H = h_V;
//Binomial transitions (out of S, I_S_2, E_M, I_A, and I_H, and within E)
double dSE_1 = rbinom(S, 1 - exp(-mu_S_E_1*dt));
double dI_A_R_A = rbinom(I_A, 1 - exp(-mu_I_A_R_A*dt));
double dE_M_I_P = rbinom(e[M-1], 1 - exp(-mu_E_M_I_P*dt));
double dI_S_2_R_F = rbinom(I_S_2, 1 - exp(-mu_I_S_2_R_F*dt));
double dI_H_R_H = rbinom(I_H, 1 - exp(-mu_I_H_R_H*dt));
//Exposed class binomial transitions (start from second compartment)
for(m = 0; m < M-1; m++){
dE_m_E_m_1[m] = rbinom(e[m], 1 - exp(-mu_E_m_E_m_1*dt));
}
//Euler multinomial transitions
//Infected Pre-symptomatic compartment
reulermultinom(2,I_P, &rate_I_P[0], dt, &trans_I_P[0]);
//Infected Symptomatic comparment
reulermultinom(2,I_S_1, &rate_I_S_1[0], dt, &trans_I_S_1[0]);
//Get compartment transitions from Euler multinom output
//Infected Pre-symptomatic Compartment
double dI_P_I_A = trans_I_P[0];
double dI_P_I_S_1 = trans_I_P[1];
//Infected Symptomatic Compartment
double dI_S_1_I_H = trans_I_S_1[0];
double dI_S_1_I_S_2 = trans_I_S_1[1];
//Update state variables using transition increments
//Susceptible Compartment
S += -dSE_1;
//Exposed Compartments
//First compartment
e[0] += dSE_1 - dE_m_E_m_1[0];
//Inner compartments (start from second compartment,
// end with second to last comparment)
for(m = 1; m < M-1; m++){
e[m] += dE_m_E_m_1[m-1] - dE_m_E_m_1[m];
}
//Outermost exposed compartment
e[M-1] += dE_m_E_m_1[M-2] - dE_M_I_P;
//Infected Compartments
//Pre-Symptomatic Infected Compartment
I_P += dE_M_I_P- dI_P_I_A - dI_P_I_S_1;
I_S_1 += dI_P_I_S_1 - dI_S_1_I_H - dI_S_1_I_S_2;
//Hospitalized Compartment
I_H += dI_S_1_I_H - dI_H_R_H;
//Flu-Like Infections Compartment
I_S_2 += dI_S_1_I_S_2 - dI_S_2_R_F;
//Recovered Compartments
I_A += dI_P_I_A - dI_A_R_A;
R_A += dI_A_R_A;
R_F += dI_S_2_R_F;
R_H += dI_H_R_H;
//Total Population (does not change)
N += 0;
//Reported Cases
C_Q1 += dI_S_1_I_H; //Entering Queue 1
C_Q3 += dI_S_1_I_S_2; //Entering Queue 2
//Read in testing info
L_int = nearbyint(L_advanced_2_days);
double epsilon = rnorm(0,sigma_epsilon);
//Calculate estimated non-COVID respiratory infections
G_w_y = g_0 + g_F*F_w_y + beta_w_3*(w*w*w) + beta_w_2*(w*w) + beta_w_1*w + beta_w_0 + epsilon;
if(t > quarantine_start_time){
G_w_y = G_w_y_scaling*G_w_y;
}else{
G_w_y = G_w_y_scaling*G_w_y;
}
C_QNC = nearbyint(G_w_y);
//Queue 1
//Initial states
neg_samples_Q1 = 0;
//Add new cases to Q1
q_1[0] = q_1[0] + C_Q1;
//Add new cases to QNC
q_nc[0] = q_nc[0] + C_QNC;
//Determine number of samples that will tested from the backlog
// of Queue 1
double total_samples_for_PCR_Testing_backlog_always_test = Backlog_Queue_1 + Backlog_Queue_NC;
//If backlog is greater than testing capacity
if(total_samples_for_PCR_Testing_backlog_always_test > L_int){
total_samples_for_PCR_Testing_backlog_Q1 = rhyper(Backlog_Queue_1, Backlog_Queue_NC, L_int);
total_samples_for_PCR_Testing_backlog_QNC = L_int - total_samples_for_PCR_Testing_backlog_Q1;
Backlog_Queue_1 = Backlog_Queue_1 - total_samples_for_PCR_Testing_backlog_Q1;
Backlog_Queue_NC = Backlog_Queue_NC - total_samples_for_PCR_Testing_backlog_QNC;
L_1 = 0;
//Else (if the testing capacity is greater than the backlog)
}else{
total_samples_for_PCR_Testing_backlog_Q1 = Backlog_Queue_1;
total_samples_for_PCR_Testing_backlog_QNC = Backlog_Queue_NC;
L_1 = L_int - total_samples_for_PCR_Testing_backlog_Q1 - total_samples_for_PCR_Testing_backlog_QNC;
Backlog_Queue_1 = 0;
Backlog_Queue_NC = 0;
}
//Simulate PCR for backlogged cases in Q1
Y_Q1_backlog = rbinom(total_samples_for_PCR_Testing_backlog_lag_2_Q1, PCR_sens);
Y_QNC_backlog = total_samples_for_PCR_Testing_backlog_lag_2_QNC;
neg_samples_Q1 = neg_samples_Q1 + total_samples_for_PCR_Testing_backlog_lag_2_Q1 - Y_Q1_backlog;
//Update PCR testing compartments for Q1 backlog
total_samples_for_PCR_Testing_backlog_lag_2_Q1 = total_samples_for_PCR_Testing_backlog_lag_1_Q1;
total_samples_for_PCR_Testing_backlog_lag_2_QNC = total_samples_for_PCR_Testing_backlog_lag_1_QNC;
total_samples_for_PCR_Testing_backlog_lag_1_Q1 = total_samples_for_PCR_Testing_backlog_Q1;
total_samples_for_PCR_Testing_backlog_lag_1_QNC = total_samples_for_PCR_Testing_backlog_QNC;
//Determine number of samples that will be tested from each sampling cohort of Queue 1
//Loop through each cohort in Queue 1 q_1[v] (and Queue NC q_nc[v])
// starting with the oldest (q_1[V-1]/q_nc[V-1])
// and ending with the most recent q_1[0]/q_nc[1].
for(v=V-1; v>=0; v--) {
//If L_1 is smaller than cohort
if(L_1 < (q_1[v] + q_nc[v])){
total_samples_for_PCR_Testing_q1[v] = rhyper(q_1[v], q_nc[v], L_1);
total_samples_for_PCR_Testing_qnc[v] = L_1 - total_samples_for_PCR_Testing_q1[v];
q_1[v] = q_1[v] - total_samples_for_PCR_Testing_q1[v];
q_nc[v] = q_nc[v] - total_samples_for_PCR_Testing_qnc[v];
L_1 = 0;
//Else there is enough capacity to test cohort v
// in Q1/QNC
}else{
total_samples_for_PCR_Testing_q1[v] = q_1[v];
total_samples_for_PCR_Testing_qnc[v] = q_nc[v];
q_1[v] = 0;
q_nc[v] = 0;
L_1 = L_1 - total_samples_for_PCR_Testing_q1[v] - total_samples_for_PCR_Testing_qnc[v];
}
}
//Simulate PCR Testing on each sampling cohort in Q1
//Loop over all cohorts v from 1:V
for(v=0; v<V; v++) {
y_q1[v] = rbinom(total_samples_for_PCR_Testing_lag_2_q1[v], PCR_sens);
y_qnc[v] = total_samples_for_PCR_Testing_lag_2_qnc[v];
neg_samples_Q1 = neg_samples_Q1 + total_samples_for_PCR_Testing_lag_2_q1[v] - y_q1[v];
}
//Update lags for total samples for PCR testing for Q1
//Loop over all cohorts v from 1:V
for(v=0; v<V; v++) {
total_samples_for_PCR_Testing_lag_2_q1[v] = total_samples_for_PCR_Testing_lag_1_q1[v];
total_samples_for_PCR_Testing_lag_2_qnc[v] = total_samples_for_PCR_Testing_lag_1_qnc[v];
total_samples_for_PCR_Testing_lag_1_q1[v] = total_samples_for_PCR_Testing_q1[v];
total_samples_for_PCR_Testing_lag_1_qnc[v] = total_samples_for_PCR_Testing_qnc[v];
}
//Update positive case matrix (p_Q1)
//For all daily sampling cohorts v within the last 14 days:
for(v=0; v<V; v++) {
p_q1[v] = p_q1[v] + y_q1[v];
}
//Re-testing (Add lagged positive samples from Queue 1 into Queue 2)
//The state variable First_re_test_Q1 are samples that were
// first re-sampled during the previous day.
// They now need to be re-sampled a second time.
Second_re_test_Q1 = First_re_test_Q1;
C_Q2 = Second_re_test_Q1;
//Let V-1 be the oldest cohort stored (V=13).
// This cohort will have their first re-sampling conducted.
First_re_test_Q1 = p_q1[V-1];
C_Q2 = C_Q2 + First_re_test_Q1;
//Increment P_Q1 Sampling Cohorts
P_Q1_old[0] = p_q1[0]; //Store first cohort
//For v in 2:V: (or in C notation v in 1:V-1):
for(v=1; v<V; v++) {
P_Q1_old[v] = p_q1[v];
p_q1[v] = P_Q1_old[v-1];
}
//For the newest cohort where v = 1 (or 0 in C notation):
p_q1[0] = 0; //(Making space for next cohort arrival)
//Note that the oldest cohort (p_q1_old[V-1]) is never used
//since p_q1[V-1] has already been transferred to First_re_test_Q1
//Create placeholder arrays to store
// current queues
for(v=0; v<V; v++) {
Q1_old[v] = q_1[v];
QNC_old[v] = q_nc[v];
}
//Add oldest cohort to backlog
// v=V (or V-1 in C notation)
Backlog_Queue_1 = Backlog_Queue_1 + Q1_old[V-1];
Backlog_Queue_NC = Backlog_Queue_NC + QNC_old[V-1];
//Update Q1 Sampling cohorts by 1
//For integer v in v>1 and v<=V
// (or in C notation v = 1 to v <V):
for(v=1; v<V; v++) {
q_1[v] = Q1_old[v-1];
q_nc[v] = QNC_old[v-1];
}
//Make space for newest cohort when v=1
// (in C notation v = 0) :
q_1[0] = 0;
q_nc[0] = 0;
//Queue 2
//Add new cases to queue
Q_2 = Q_2+C_Q2;
//Determine number of samples that will be tested from Queue 2
//Recall that L2 is the testing capacity available at the end of Queue 2.
L_2 = L_1;
//If there is not enough testing capacity to test all of Queue 2
if (Q_2 > L_2){
total_samples_for_PCR_Testing_Q2 = L_2;
Q_2 = Q_2 - L_2;
L_2 = 0;
//Else if there is enough capcity to test all of Queue 2
}else{
total_samples_for_PCR_Testing_Q2 = Q_2;
Q_2 = 0;
L_2 = L_2 - total_samples_for_PCR_Testing_Q2;
}
//Recall that we do not keep track of the results of the PCR testing in Queue 2,
//as it will not impact the count of reported cases.
//We are also not worried about lags here.
//Queue 3
//Initial states
neg_samples_Q3 = 0;
L_3 = L_2;
//Take into account loss rate due to recovery
//NOT IMPLEMENTED YET
double mu_2 = gamma;
double single_cohort_loss = 0;
for(k=0; k<K; k++) {
single_cohort_loss = rbinom(q_3[k], 1 - exp(-mu_2*dt));
q_3[k] = q_3[k] - single_cohort_loss;
}
double backlog_loss = rbinom(Backlog_Queue_3, 1 - exp(-mu_2*dt));
Backlog_Queue_3 = Backlog_Queue_3 - backlog_loss;
//Simulate loss in Q3 backlog
//Add new cases to Q3
q_3[0] = q_3[0] + C_Q3;
//Determine number of samples that will be tested from the backlog of Queue 3
//If Backlog is greater than testing capacity:
if(Backlog_Queue_3 > L_3){
total_samples_for_PCR_Testing_backlog_Q3 = L_3;
Backlog_Queue_3 = Backlog_Queue_3 - L_3;
L_3 = 0;
//There is enough capcity to test the whole Q_3 backlog
}else{
total_samples_for_PCR_Testing_backlog_Q3 = Backlog_Queue_3;
L_3 = L_3 - total_samples_for_PCR_Testing_backlog_Q3;
Backlog_Queue_3 = 0;
}
//Simulate PCR for backlogged cases in Q3
Y_Q3_backlog = rbinom(total_samples_for_PCR_Testing_backlog_lag_2_Q3, PCR_sens);
neg_samples_Q3 = neg_samples_Q3 + total_samples_for_PCR_Testing_backlog_lag_2_Q3 - Y_Q3_backlog;
//Update PCR testing compartments for Q3 backlog
total_samples_for_PCR_Testing_backlog_lag_2_Q3 = total_samples_for_PCR_Testing_backlog_lag_1_Q3;
total_samples_for_PCR_Testing_backlog_lag_1_Q3 = total_samples_for_PCR_Testing_backlog_Q3;
//Determine number of samples that will be tested from each sampling cohort of Queue 3
//Loop through each cohort in Queue 3 (Q3_k) starting with the oldest (Q3_K)
// and ending with the most recent (Q3_1).
for(k=K-1; k>=0; k--) {
//If L_3 is smaller than cohort (i.e. L_3 < Q_{3_k} :
if(q_3[k] > L_3){
total_samples_for_PCR_Testing_q3[k] = L_3;
q_3[k] = q_3[k] - L_3;
L_3 = 0;
//There is enough capacity to test cohort $k$
}else{
total_samples_for_PCR_Testing_q3[k] = q_3[k];
q_3[k] = 0;
L_3 = L_3 - total_samples_for_PCR_Testing_q3[k];
}
}
//Simulate PCR Testing on each sampling cohort in Q3
//Loop over all cohorts k from 1:K
for(k=0; k<K; k++) {
y_q3[k] = rbinom(total_samples_for_PCR_Testing_lag_2_q3[k], PCR_sens);
neg_samples_Q3 = neg_samples_Q3 + total_samples_for_PCR_Testing_lag_2_q3[k] - y_q3[k];
}
//Update lags for total samples for PCR testing for Q3
for(k=0; k<K; k++) {
total_samples_for_PCR_Testing_lag_2_q3[k] = total_samples_for_PCR_Testing_lag_1_q3[k];
total_samples_for_PCR_Testing_lag_1_q3[k] = total_samples_for_PCR_Testing_q3[k];
}
//Update positive case matrix (P_Q3)
//For all daily sampling cohorts k within the last 14 days:
for(k=0; k<K; k++) {
p_q3[k] = p_q3[k] + y_q3[k];
}
//Re-testing (Add lagged positive samples from Queue 3 into Queue 4)
//The state variable First_re_test_Q3 are samples that we first re-sampled
// during the previous day. They now need to be re-sampled a second time.
Second_re_test_Q3 = First_re_test_Q3;
C_Q4 = Second_re_test_Q3;
//Let K be the oldest cohort stored (K=14).
//This cohort will have their first re-sampling conducted.
// We use K-1 for C notation.
First_re_test_Q3 = p_q3[K-1];
C_Q4 = C_Q4 + First_re_test_Q3;
//Increment P_Q3 Sampling Cohorts
P_Q3_old[0] = p_q3[0]; //Store first cohort
//For k in 2:K: (or in C notation k in 1:K-1):
for(k=1; k<K; k++) {
P_Q3_old[k] = p_q3[k];
p_q3[k] = P_Q3_old[k-1];
}
//For the newest cohort where k = 1 (or k=0 in C notation):
p_q3[0] = 0; //(Making space for next cohort arrival)
//Note that the oldest cohort (p_q3_old[K-1]) is never used
//since p_q3[K-1] has already been transferred to First_re_test_Q3
//Create placeholder array to store
// current Q3
for(k=0; k<K; k++) {
Q3_old[k] = q_3[k];
}
//Add oldest cohort to backlog
// k=K (or K-1 in C notation)
Backlog_Queue_3 = Backlog_Queue_3 + Q3_old[K-1];
//Update Q3 Sampling cohorts by 1
//For integer k in k>1 and k<=K
// (or in C notation k = 1 to k < K):
for(k=1; k<K; k++) {
q_3[k] = Q3_old[k-1];
}
//Make space for newest cohort when k=1
// (in C notation k = 0) :
q_3[0] = 0;
//Queue 4
//Add new cases to queue
Q_4 = Q_4 + C_Q4;
//Determine number of samples that will be tested from Queue 4
//Recall that L_4 is the testing capacity available at the end of Queue 4.
L_4 = L_3;
//If there is insufficent capacity (Queue 4 is bigger than L_4)
if(Q_4>L_4){
total_samples_for_PCR_Testing_Q4 = L_4;
Q_4 = Q_4 - L_4;
L_4 = 0;
//There is enough capacity(Q_4 < L_4)
}else{
total_samples_for_PCR_Testing_Q4 = Q_4;
Q_4 = 0;
L_4 = L_4 - total_samples_for_PCR_Testing_Q4;
}
//Recall that we do not keep track of the results of the PCR testing in Queue 4,
//as it will not impact the count of reported cases.
//We are also not worried about lags here,
//and we assume that all samples that enter Queue 4
//are eventually tested (no additional loss rates).
//Queue 5:Asymptomatic Testing
total_sample_size = S + E_1 + E_2 + E_3 + E_4 + E_5 + I_P + I_S_1 + R_A + R_F + R_H;
multinom_prob[0] = PCR_sens*E_1/total_sample_size;
multinom_prob[1] = PCR_sens*E_2/total_sample_size;
multinom_prob[2] = PCR_sens*E_3/total_sample_size;
multinom_prob[3] = PCR_sens*E_4/total_sample_size;
multinom_prob[4] = PCR_sens*E_5/total_sample_size;
multinom_prob[5] = PCR_sens*I_P/total_sample_size;
multinom_prob[6] = PCR_sens*I_S_1/total_sample_size;
double total_Q5_prob = multinom_prob[0] + multinom_prob[1] + multinom_prob[2];
total_Q5_prob = total_Q5_prob + multinom_prob[3] + multinom_prob[4] + multinom_prob[5];
total_Q5_prob = total_Q5_prob + multinom_prob[6] ;
multinom_prob[7] = 1 - total_Q5_prob;
//rmultinom(1,L_4, &multinom_prob, &multinom_output);
rmultinom(L_4, &multinom_prob[0], 8, &multinom_output[0]);
double E_1_infected = 0;
double E_2_infected = 0;
double E_3_infected = 0;
double E_4_infected = 0;
double E_5_infected = 0;
double I_P_infected = 0;
double I_S_1_infected = 0;
neg_samples_Q5 = 0;
//Update population comparmtents
E_1 = E_1 - E_1_infected;
E_2 = E_2 - E_2_infected;
E_3 = E_3 - E_3_infected;
E_4 = E_4 - E_4_infected;
E_5 = E_5 - E_5_infected;
I_P = I_P - I_P_infected;
I_S_1 = I_S_1 - I_S_1_infected;
Y_Q5 = E_1_infected + E_2_infected + E_3_infected + E_4_infected + E_5_infected +I_P_infected + I_S_1_infected;
A_T = A_T + Y_Q5;
//Calculate total cases to report
total_neg_samples_all_queues = 0;
for(v=0; v<V; v++) {
Y_sum = Y_sum + y_q1[v];
total_neg_samples_all_queues = total_neg_samples_all_queues + y_qnc[v];
}
for(k=0; k<K; k++) {
Y_sum = Y_sum + y_q3[k];
}
Y_sum = Y_sum + Y_Q1_backlog + Y_Q3_backlog;
total_neg_samples_all_queues = total_neg_samples_all_queues +neg_samples_Q1;
total_neg_samples_all_queues = total_neg_samples_all_queues +neg_samples_Q3;
//double positive_plus_negative_tests = Y_sum + total_neg_samples_all_queues;
//Prop_Positive_Tests_Track = Y_sum/positive_plus_negative_tests;
//Toy Reporting (Queues not yet implemented)
//Y_Q1 = C_Q1;
//Y_Q3 = C_Q3;
//Y_sum = C_Q1 + C_Q3;
if(L_orig >0){
Prop_Positive_Tests_Track = Y_sum/L_orig;
}else{
Prop_Positive_Tests_Track = 0; //Assign 0 if no testing yet
}
//Error checks- Bottom of model
if(R_A < 0 || R_F < 0 || R_H < 0 || I_A < 0 || I_P < 0 || I_H < 0 || I_S_1 < 0 || I_S_2 < 0 || S < 0 || N < 0 || Backlog_Queue_1 < 0 || Q_2 < 0 ||Backlog_Queue_3 < 0 || Q_4 < 0 |Backlog_Queue_NC < 0|| First_re_test_Q1 < 0 || Second_re_test_Q1 < 0 || First_re_test_Q3 < 0 || Second_re_test_Q3 < 0 || total_samples_for_PCR_Testing_backlog_Q1 < 0 || total_samples_for_PCR_Testing_backlog_lag_1_Q1 < 0 || total_samples_for_PCR_Testing_backlog_lag_2_Q1 < 0 || total_samples_for_PCR_Testing_backlog_Q3 < 0 || total_samples_for_PCR_Testing_backlog_lag_1_Q3 < 0 || total_samples_for_PCR_Testing_backlog_lag_2_Q3 < 0 ||total_samples_for_PCR_Testing_backlog_QNC < 0 || total_samples_for_PCR_Testing_backlog_lag_1_QNC < 0 || total_samples_for_PCR_Testing_backlog_lag_2_QNC < 0 || neg_samples_Q1 < 0 || neg_samples_Q3 < 0 || total_neg_samples_all_queues < 0 || L_advanced_2_days < 0 || G_w_y < 0 || L_int < 0 || F_w_y < 0 || L_1 < 0 || w < 0 || L_2 < 0 || L_3 < 0 || L_4 < 0 || y < 0){
Neg_State_Value_Detected = TRUE;
Rprintf(\"Negative state variable detected at bottom of process model t = %lg \\n\", t);
}
sum_everything = R_A + R_F + R_H + I_A + I_P + I_H + I_S_1 + I_S_2 + S + N;
sum_everything = sum_everything + Backlog_Queue_1 + Backlog_Queue_3 + Backlog_Queue_NC + Q_2 + Q_4;
sum_everything = sum_everything + First_re_test_Q1 + First_re_test_Q3 +Second_re_test_Q1 + Second_re_test_Q3;
sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_Q1 + total_samples_for_PCR_Testing_backlog_Q3 + total_samples_for_PCR_Testing_backlog_QNC;
sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_lag_1_Q1 + total_samples_for_PCR_Testing_backlog_lag_1_Q3 + total_samples_for_PCR_Testing_backlog_lag_1_QNC;
sum_everything = sum_everything + total_samples_for_PCR_Testing_backlog_lag_2_Q1 + total_samples_for_PCR_Testing_backlog_lag_2_Q3 + total_samples_for_PCR_Testing_backlog_lag_2_QNC;
sum_everything = sum_everything + neg_samples_Q1 + neg_samples_Q3 + total_neg_samples_all_queues;
sum_everything = sum_everything + L_advanced_2_days + G_w_y + F_w_y + L_int + L_1 + L_2 + L_3 + L_4 + w + y;
if(isnan(sum_everything)){
NAN_State_Value_Detected = TRUE;
Rprintf(\"nan state variable detected at bottom of process model t = %lg \\n\", t);
}
//Check Exposed Compartments
for(m=0; m<M; m++) {
if(isnan(e[m])){
NAN_State_Value_Detected = TRUE;
Rprintf(\"nan state variable detected at bottom of process model t = %lg \\n\", t);
}
if(e[m] < 0) {
Neg_State_Value_Detected = TRUE;
Rprintf(\"Negative state variable detected at bottom of process model t = %lg \\n\", t);
}
}
//Check Q_1 and Q_NC arrays
for(v=0; v<V; v++) {
if(isnan(q_1[v]) || isnan(q_nc[v]) || isnan(p_q1[v]) || isnan(total_samples_for_PCR_Testing_q1[v]) || isnan(total_samples_for_PCR_Testing_qnc[v]) || isnan(total_samples_for_PCR_Testing_lag_1_q1[v]) || isnan(total_samples_for_PCR_Testing_lag_1_qnc[v]) || isnan(total_samples_for_PCR_Testing_lag_2_q1[v]) || isnan(total_samples_for_PCR_Testing_lag_2_qnc[v])){
NAN_State_Value_Detected = TRUE;
Rprintf(\"nan state variable detected at bottom of process model t = %lg \\n\", t);
}
if(q_1[v] < 0 || q_nc[v] < 0 || p_q1[v] < 0 || total_samples_for_PCR_Testing_q1[v] < 0 || total_samples_for_PCR_Testing_qnc[v] < 0 || total_samples_for_PCR_Testing_lag_1_q1[v] < 0 || total_samples_for_PCR_Testing_lag_1_qnc[v] < 0 || total_samples_for_PCR_Testing_lag_2_q1[v] < 0 || total_samples_for_PCR_Testing_lag_2_qnc[v] < 0 ) {
Neg_State_Value_Detected = TRUE;
Rprintf(\"Negative state variable detected at bottom of process model t = %lg \\n\", t);
}
}
//Check Q_3 Arrays
for(k=0; k<K; k++) {
if(isnan(q_3[k]) || isnan(p_q3[k]) || isnan(total_samples_for_PCR_Testing_q3[k]) || isnan(total_samples_for_PCR_Testing_lag_1_q3[k]) || isnan(total_samples_for_PCR_Testing_lag_2_q3[k]) || isnan(q_3[k])){
NAN_State_Value_Detected = TRUE;
Rprintf(\"nan state variable detected at bottom of process model t = %lg \\n\", t);
}
if(q_3[k] < 0 || p_q3[k] < 0 || total_samples_for_PCR_Testing_q3[k] < 0 || total_samples_for_PCR_Testing_lag_1_q3[k] < 0 || total_samples_for_PCR_Testing_lag_2_q3[k] < 0 ) {
Neg_State_Value_Detected = TRUE;
Rprintf(\"Negative state variable detected at bottom of process model t = %lg \\n\", t);
}
}
int print_out_bottom = (Error_Printing_Complete == FALSE) & (Neg_State_Value_Detected == TRUE || NAN_State_Value_Detected == TRUE);
if(print_out_bottom){
Rprintf(\"I_S_1 = %lg \\n\", I_S_1);
Rprintf(\"I_S_2 = %lg \\n\", I_S_2);
Rprintf(\"I_H = %lg \\n\", I_H);
Rprintf(\"I_A = %lg \\n\", I_A);
Rprintf(\"I_P = %lg \\n\", I_P);
Rprintf(\"Backlog_Queue_1 = %lg \\n\", Backlog_Queue_1);
Rprintf(\"Backlog_Queue_3 = %lg \\n\", Backlog_Queue_3);
Rprintf(\"Backlog_Queue_NC = %lg \\n\", Backlog_Queue_NC);
Rprintf(\"First_re_test_Q1 = %lg \\n\", First_re_test_Q1);
Rprintf(\"First_re_test_Q3 = %lg \\n\", First_re_test_Q3);
Rprintf(\"Second_re_test_Q1 = %lg \\n\", Second_re_test_Q1);
Rprintf(\"Second_re_test_Q3 = %lg \\n\", Second_re_test_Q3);
Rprintf(\"total_samples_for_PCR_Testing_backlog_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_Q1);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_Q1);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_Q1 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_Q1);
Rprintf(\"total_samples_for_PCR_Testing_backlog_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_Q3);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_Q3);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_Q3 = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_Q3);
Rprintf(\"total_samples_for_PCR_Testing_backlog_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_QNC);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_1_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_1_QNC);
Rprintf(\"total_samples_for_PCR_Testing_backlog_lag_2_QNC = %lg \\n\", total_samples_for_PCR_Testing_backlog_lag_2_QNC);
Rprintf(\"neg_samples_Q1 = %lg \\n\", neg_samples_Q1);
Rprintf(\"neg_samples_Q3 = %lg \\n\", neg_samples_Q3);
Rprintf(\"total_neg_samples_all_queues = %lg \\n\", total_neg_samples_all_queues);
Rprintf(\"Q_2 = %lg \\n\", Q_2);
Rprintf(\"Q_4 = %lg \\n\", Q_4);
Rprintf(\"F_w_y = %lg \\n\", F_w_y);
Rprintf(\"w = %lg \\n\", w);
Rprintf(\"y = %lg \\n\", y);
Rprintf(\"E_1 = %lg \\n\", E_1);
Rprintf(\"E_2 = %lg \\n\", E_2);
Rprintf(\"E_3 = %lg \\n\", E_3);
Rprintf(\"E_4 = %lg \\n\", E_4);
Rprintf(\"E_5 = %lg \\n\", E_5);
Rprintf(\"I_P = %lg \\n\", I_P);
Rprintf(\"dE_m_E_m_1[M-2] = %lg \\n\", dE_m_E_m_1[M-2]);
Rprintf(\"lambda_FOI = %lg \\n\", lambda_FOI);
Rprintf(\"E_1_infected = %lg \\n\", E_1_infected);
Rprintf(\"dSE_1 = %lg \\n\", dSE_1);
Rprintf(\"dE_m_E_m_1[0] = %lg \\n\", dE_m_E_m_1[0]);
Rprintf(\"beta_t = %lg \\n\", beta_t);
Rprintf(\"beta_a = %lg \\n\", beta_a);
Rprintf(\"dE_m_E_m_1[0] = %lg \\n\", dE_m_E_m_1[0]);
Rprintf(\"dE_m_E_m_1[1] = %lg \\n\", dE_m_E_m_1[1]);
Rprintf(\"dE_m_E_m_1[2] = %lg \\n\", dE_m_E_m_1[2]);
Rprintf(\"dI_P_I_A = %lg \\n\", dI_P_I_A);
Rprintf(\"dI_P_I_S_1 = %lg \\n\", dI_P_I_S_1);
Rprintf(\"dE_M_I_P = %lg \\n\", dE_M_I_P);
Rprintf(\"R_H = %lg \\n\", R_H);
Rprintf(\"R_A = %lg \\n\", R_A);
Rprintf(\"R_F = %lg \\n\", R_F);
Rprintf(\"N = %lg \\n\", N);
Rprintf(\"S = %lg \\n\", S);
Rprintf(\"L_advanced_2_days = %lg \\n\", L_advanced_2_days);
Rprintf(\"G_w_y = %lg \\n\", G_w_y);
Rprintf(\"L_int = %lg \\n\", L_int);
Rprintf(\"L_1 = %lg \\n\", L_1);
Rprintf(\"L_2 = %lg \\n\", L_2);
Rprintf(\"L_3 = %lg \\n\", L_3);
Rprintf(\"L_4 = %lg \\n\", L_4);
Rprintf(\"Print out params p_S = %lg \\n\", p_S);
Rprintf(\"p_H_cond_S = %lg \\n\", p_H_cond_S);
Rprintf(\"phi_E = %lg \\n\", phi_E);
Rprintf(\"phi_U = %lg \\n\", phi_U);
Rprintf(\"phi_S = %lg \\n\", phi_S);
Rprintf(\"h_V = %lg \\n\", h_V);
Rprintf(\"gamma = %lg \\n\", gamma);
Rprintf(\"R_0 = %lg \\n\", R_0);
Rprintf(\"b_q = %lg \\n\", b_q);
Rprintf(\"b_a = %lg \\n\", b_a);
Rprintf(\"b_p = %lg \\n\", b_p);
Rprintf(\"z_0 = %lg \\n\", z_0);
Rprintf(\"E_0 = %lg \\n\", E_0);
Rprintf(\"N_0 = %lg \\n\", N_0);
Rprintf(\"C_0 = %lg \\n\", C_0);
Rprintf(\"G_w_y_scaling = %lg \\n\", G_w_y_scaling);
Rprintf(\"quarantine_start_time = %lg \\n\", quarantine_start_time);
Rprintf(\"PCR_sens = %lg \\n\", PCR_sens);
Rprintf(\"sigma_M = %lg \\n\", sigma_M);
Rprintf(\"beta_w_3 = %lg \\n\", beta_w_3);
Rprintf(\"beta_w_2 = %lg \\n\", beta_w_2);
Rprintf(\"beta_w_1 = %lg \\n\", beta_w_1);
Rprintf(\"beta_w_0 = %lg \\n\", beta_w_0);
Rprintf(\"g_0 = %lg \\n\", g_0);
Rprintf(\"g_F = %lg \\n\", g_F);
Rprintf(\"sigma_epsilon = %lg \\n\", sigma_epsilon);
//Print out exposed compartments
for(m=0; m<M; m++) {
Rprintf(\"m = %d \\n\", m);
Rprintf(\"e[m] = %lg \\n\", e[m]);
}
//Print out Q_1 and Q_NC compartments
for(v=0; v<V; v++) {
Rprintf(\"v = %d \\n\", v);
Rprintf(\"q_1[v] = %lg \\n\", q_1[v]);
Rprintf(\"q_nc[v] = %lg \\n\", q_nc[v]);
Rprintf(\"p_q1[v] = %lg \\n\", p_q1[v]);
Rprintf(\"y_q1[v] = %lg \\n\", y_q1[v]);
Rprintf(\"total_samples_for_PCR_Testing_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_q1[v]);
Rprintf(\"total_samples_for_PCR_Testing_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_qnc[v]);
Rprintf(\"total_samples_for_PCR_Testing_lag_1_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_q1[v]);
Rprintf(\"total_samples_for_PCR_Testing_lag_1_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_qnc[v]);
Rprintf(\"total_samples_for_PCR_Testing_lag_2_q1[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_q1[v]);
Rprintf(\"total_samples_for_PCR_Testing_lag_2_qnc[v] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_qnc[v]);
}
//Print out Q_3 compartments
for(k=0; k<K; k++) {
Rprintf(\"k = %d \\n\", k);
Rprintf(\"q_3[k] = %lg \\n\", q_3[k]);
Rprintf(\"p_q3[k] = %lg \\n\", p_q3[k]);
Rprintf(\"y_q3[k] = %lg \\n\", y_q3[k]);
Rprintf(\"total_samples_for_PCR_Testing_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_q3[k]);
Rprintf(\"total_samples_for_PCR_Testing_lag_1_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_lag_1_q3[k]);
Rprintf(\"total_samples_for_PCR_Testing_lag_2_q3[k] = %lg \\n\", total_samples_for_PCR_Testing_lag_2_q3[k]);
}
Error_Printing_Complete = TRUE;
}
")Initialization Csnippet
init <- Csnippet("
//Rprintf(\"At top of init N_0 = %lg \\n\", N_0);
//Rprintf(\"At top of init E_0 = %lg \\n\", E_0);
int M = (int) M_0; //Number of exposed compartments
int V = (int) V_0; //Number of days spent in hospital (number of cohorts in Queues 1 and NC)
int K = (int) K_0; //Number of days spent in quarantine (number of cohorts in Queue 3)
int m; //Exposed compartment number
int v; //Queue 1/ Queue NC cohort number
int k; //Queue 3 cohort number
//Declare E pointer array
double *e=&E_1;
//Declare Queue 1 pointer arrays
double *q_1=&Q_1_1;
double *p_q1=&P_Q1_1;
double *total_samples_for_PCR_Testing_q1=&total_samples_for_PCR_Testing_Q1_1;
double *total_samples_for_PCR_Testing_lag_1_q1=&total_samples_for_PCR_Testing_lag_1_Q1_1;
double *total_samples_for_PCR_Testing_lag_2_q1=&total_samples_for_PCR_Testing_lag_2_Q1_1;
double *y_q1=&Y_Q1_1;
//Declare Queue NC pointer arrays
double *q_nc=&Q_NC_1;
double *total_samples_for_PCR_Testing_qnc=&total_samples_for_PCR_Testing_QNC_1;
double *total_samples_for_PCR_Testing_lag_1_qnc=&total_samples_for_PCR_Testing_lag_1_QNC_1;
double *total_samples_for_PCR_Testing_lag_2_qnc=&total_samples_for_PCR_Testing_lag_2_QNC_1;
double *y_qnc=&Y_QNC_1;
//Declare Queue 3 pointer arrays
double *q_3=&Q_3_1;
double *p_q3=&P_Q3_1;
double *total_samples_for_PCR_Testing_q3=&total_samples_for_PCR_Testing_Q3_1;
double *total_samples_for_PCR_Testing_lag_1_q3=&total_samples_for_PCR_Testing_lag_1_Q3_1;
double *total_samples_for_PCR_Testing_lag_2_q3=&total_samples_for_PCR_Testing_lag_2_Q3_1;
double *y_q3=&Y_Q3_1;
double E_init_total = 0;
double I_init_total = 0;
if(z_0 > N_0){
I_init_total = nearbyint(N_0);
E_init_total = 0;
S = 0;
}else{
if(E_0 > N_0){
E_init_total = nearbyint(N_0);
I_init_total = 0;
S = 0;
}else{
E_init_total = nearbyint(E_0);
int extra_cap = nearbyint(N_0) - nearbyint(E_0);
if(extra_cap < nearbyint(z_0)){
I_init_total = nearbyint(extra_cap);
S = 0;
}else{
I_init_total = nearbyint(z_0);
S = nearbyint(N_0) - nearbyint(z_0) - nearbyint(E_0);
}
}
}
//Assign early stage infections
double time_pre_symp = 1/phi_U;
double time_symp = 1/phi_S;
double prop_time_pre_symp = time_pre_symp/(time_pre_symp + time_symp);
double total_init_I_symp = nearbyint(p_S*I_init_total);
I_A = nearbyint((1-p_S)*I_init_total);
I_P = nearbyint(prop_time_pre_symp*total_init_I_symp);
I_S_1 = nearbyint((1-prop_time_pre_symp)*total_init_I_symp);
//Late stage infection compartments
I_S_2 = 0;
I_H = 0;
//Recovered Compartments
R_A = 0;
R_F = 0;
R_H = 0;
//Whole Population
N = nearbyint(N_0);
//Asymptomatic Testing Positive Cases (in isolation)
A_T = 0;
//Transmission Rate
double total_time_infected = (1/gamma) + (1/phi_S);
double gamma_total = 1/total_time_infected;
double Beta_0 = R_0*(gamma_total);
beta_t = Beta_0;
//Reported Cases
C_Q1 = nearbyint(p_H_cond_S*C_0);
C_Q2 = 0;
C_Q3 = nearbyint((1-p_H_cond_S)*C_0);
C_Q4 = 0;
Y_sum = 0;
//Queue
L_int = nearbyint(L_advanced_2_days);
L_1 = 0;
L_2 = 0;
L_3 = 0;
L_4 = 0;
Prop_Positive_Tests_Track = 0;
G_w_y = 0;
Q_2 = 0;
Q_4 = 0;
Backlog_Queue_1 = 0;
Backlog_Queue_NC = 0;
Backlog_Queue_3 = 0;
First_re_test_Q1 = 0;
First_re_test_Q3 = 0;
Second_re_test_Q1 = 0;
Second_re_test_Q3 = 0;
total_samples_for_PCR_Testing_backlog_QNC = 0;
total_samples_for_PCR_Testing_backlog_Q1 = 0;
total_samples_for_PCR_Testing_backlog_Q3 = 0;
total_samples_for_PCR_Testing_backlog_lag_1_Q1 = 0;
total_samples_for_PCR_Testing_backlog_lag_1_Q3 = 0;
total_samples_for_PCR_Testing_backlog_lag_1_QNC = 0;
total_samples_for_PCR_Testing_backlog_lag_2_Q1 = 0;
total_samples_for_PCR_Testing_backlog_lag_2_Q3 = 0;
total_samples_for_PCR_Testing_backlog_lag_2_QNC = 0;
total_samples_for_PCR_Testing_Q2 = 0;
total_samples_for_PCR_Testing_Q4 = 0;
neg_samples_Q1 = 0;
neg_samples_Q3 = 0;
neg_samples_Q5 = 0;
total_neg_samples_all_queues = 0;
Y_Q1_backlog = 0;
Y_QNC_backlog = 0;
Y_Q3_backlog = 0;
//Initialize Q5 variables
infected_sample_size = 0;
total_sample_size = 0;
prob_infected_Q5 = 0;
total_samples_for_PCR_Testing_Q5 = 0;
Y_Q5 = 0;
//Initialize Arrays
//Exposed compartment (including first one)
for(m = 0; m < M; m++){
e[m] = nearbyint(E_init_total/5);
}
//Queue 1 and Queue NC arrays
for(v = 0; v < V; v++){
q_1[v] = 0;
q_nc[v] = 0;
p_q1[v] = 0;
total_samples_for_PCR_Testing_q1[v] = 0;
total_samples_for_PCR_Testing_qnc[v] = 0;
total_samples_for_PCR_Testing_lag_1_q1[v] = 0;
total_samples_for_PCR_Testing_lag_1_qnc[v] = 0;
total_samples_for_PCR_Testing_lag_2_q1[v] = 0;
total_samples_for_PCR_Testing_lag_2_qnc[v] = 0;
y_q1[v] = 0;
y_qnc[v] = 0;
}
//Queue 3 arrays
for(k = 0; k < K; k++){
q_3[k] = 0;
p_q3[k] = 0;
total_samples_for_PCR_Testing_q3[k] = 0;
total_samples_for_PCR_Testing_lag_1_q3[k] = 0;
total_samples_for_PCR_Testing_lag_2_q3[k] = 0;
y_q3[k] = 0;
}
//Set Flags
Neg_State_Value_Detected = FALSE;
NAN_State_Value_Detected = FALSE;
Error_Printing_Complete = FALSE;
//Rprintf(\"At init N = %lg \\n\", N);
//Rprintf(\"At init S = %lg \\n\", S);
//Rprintf(\"At init E_1 = %lg \\n\", E_1);
//Rprintf(\"At init I_P = %lg \\n\", I_P);
//Rprintf(\"At init I_S_1 = %lg \\n\", I_S_1);
//Rprintf(\"At init C_Q1 = %lg \\n\", C_Q2);
")Parameter Transforms
par_trans = parameter_trans(log = c("R_0", "gamma", "h_V",
"phi_E", "phi_U", "phi_S",
"E_0", "z_0", "N_0", "C_0", "sigma_M"),
logit = c("PCR_sens", "p_S", "p_H_cond_S",
"b_q", "b_a", "b_p", "G_w_y_scaling"))Measurement Model
rmeas <- Csnippet("
double size = 1.0/sigma_M/sigma_M;
Y = rnbinom_mu(size,Y_sum);
double prop_sd = sqrt(Prop_Positive_Tests_Track*(1-Prop_Positive_Tests_Track)/L_int);
obs_prop_positive = rnorm(Prop_Positive_Tests_Track, prop_sd);
")dmeas <- Csnippet("
if(isnan(Y)){
lik = 0;
}else{
if(G_w_y_scaling > 0.33){
lik = -39;
}else{
double size = 1.0/sigma_M/sigma_M;
static double tol = 0.1;
double prop_sd = sqrt(Prop_Positive_Tests_Track*(1-Prop_Positive_Tests_Track)/L_int);
double lik_2 = dnorm(obs_prop_positive,Prop_Positive_Tests_Track,prop_sd,1);
lik = dnbinom_mu(Y,size,Y_sum+tol,1);
}
}
//Debugging Print Code
//Rprintf(\"t = %lg \\n\", t);
//Rprintf(\"I_S_1 = %lg \\n\", I_S_1);
//Rprintf(\"Lik = %lg \\n\", lik);
//Rprintf(\"Y = %lg \\n\", Y);
//Rprintf(\"Y_sum = %lg \\n\", Y_sum);
//Rprintf(\"tol = %lg \\n\", tol);
//Rprintf(\"size = %lg \\n\", size);
if (!give_log) lik = exp(lik);
")Simulate from reasonable parameters
Definte reasonable parameters
##Initial param guesses
phi_E = 1.09
phi_U = phi_E
phi_S = 1/5
h_V = 1/13
p_S = 0.15
p_H_cond_S = 0.30
gamma = 1/3
true_quarantine_start_time= as.Date("2020-03-23")
true_social_distancing_start_time = as.Date("2020-03-19")
converted_quarantine_start_time = true_quarantine_start_time - true_start_date
converted_quarantine_start_time## Time difference of 22 daysquarantine_start_time = as.numeric(converted_quarantine_start_time)
converted_social_distancing_start_time = true_social_distancing_start_time - true_start_date
converted_social_distancing_start_time## Time difference of 18 dayssocial_distancing_start_time = as.numeric(converted_social_distancing_start_time)
PCR_sens = 0.90
b_a = 1
R_0 = 10.25
b_q = .08
b_p = 0;
E_0 = 15200
z_0 = 15200
N_0 = 8.0e6
C_0 = 0
sigma_M = 0.25
G_w_y_scaling = 0.162
param_vec = c(M_0 = M,
V_0 = V,
K_0 = K,
phi_E = phi_E,
phi_U = phi_U,
phi_S = phi_S,
h_V = h_V,
p_S = p_S,
p_H_cond_S = p_H_cond_S,
gamma = gamma,
quarantine_start_time = quarantine_start_time,
social_distancing_start_time = social_distancing_start_time,
PCR_sens = PCR_sens,
b_q = b_q,
b_a = b_a,
b_p = b_p,
R_0 = R_0,
E_0 = E_0,
z_0 = z_0,
N_0 = N_0,
C_0 = C_0,
sigma_M = sigma_M,
beta_w_3 = beta_w_3,
beta_w_2 = beta_w_2,
beta_w_1 = beta_w_1,
beta_w_0 = beta_w_0,
g_0 = g_0,
g_F = g_F,
sigma_epsilon = sigma_epsilon,
G_w_y_scaling = G_w_y_scaling)
param_vec## M_0 V_0
## 5.000000e+00 1.300000e+01
## K_0 phi_E
## 1.400000e+01 1.090000e+00
## phi_U phi_S
## 1.090000e+00 2.000000e-01
## h_V p_S
## 7.692308e-02 1.500000e-01
## p_H_cond_S gamma
## 3.000000e-01 3.333333e-01
## quarantine_start_time social_distancing_start_time
## 2.200000e+01 1.800000e+01
## PCR_sens b_q
## 9.000000e-01 8.000000e-02
## b_a b_p
## 1.000000e+00 0.000000e+00
## R_0 E_0
## 1.025000e+01 1.520000e+04
## z_0 N_0
## 1.520000e+04 8.000000e+06
## C_0 sigma_M
## 0.000000e+00 2.500000e-01
## beta_w_3 beta_w_2
## 1.215073e-02 9.810086e-01
## beta_w_1 beta_w_0
## -3.723481e+01 2.294094e+02
## g_0 g_F
## 1.183300e+03 1.162005e-01
## sigma_epsilon G_w_y_scaling
## 1.091121e+02 1.620000e-01Call simulate
sim_data = simulate(nsim = 100,
seed = 23456,
times = Observed_data$times,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
covar = covar,
format = "data.frame",
obs = FALSE)## in 'pomp': the unrecognized argument 'obs' is available for use by the POMP basic components.#head(sim_data)Plot from simulated data
sim_data_median_Y = aggregate(Y ~ time, sim_data, median)
sim_data_quant = aggregate(Y ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_quant$Y = as.data.frame(sim_data_quant$Y)
colnames(sim_data_quant$Y) = c("Q2.5", "Q97.5")
comp_data = data.frame(time = sim_data_median_Y$time,
sim_data_median = sim_data_median_Y$Y,
sim_data_low_Q = sim_data_quant$Y$Q2.5,
sim_data_high_Q = sim_data_quant$Y$Q97.5,
true_data = Observed_data$Y)
comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
"sim_data_high_Q"))
p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
ymax = sim_data_high_Q), fill = "grey70") +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable)) +
rahul_theme +
theme_white_background +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
median_legend_lab +
xlab("Days since March 1 2020")+
ylab("Observed Daily Cases")
p
figure_name = paste0("../Figures/Local_Simulation_Tests/", model_name, "_test_sim_from_inital_params.png")
png(figure_name)
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = log(sim_data_low_Q),
ymax = log(sim_data_high_Q)), fill = "grey70") +
geom_line(aes(x = time, y = log(value), color = variable)) +
geom_point(aes(x = time, y = log(value), color = variable)) +
rahul_theme +
theme_white_background +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
median_legend_lab +
xlab("Days since March 1 2020")+
ylab("Observed Daily Cases")
p
### S over N
sim_data$S_over_N = sim_data$S/sim_data$N
sim_data_S_over_N_median = aggregate(S_over_N ~ time, sim_data, median)
sim_data_S_over_N_quant = aggregate(S_over_N ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_S_over_N_quant$S_over_N = as.data.frame(sim_data_S_over_N_quant$S_over_N)
colnames(sim_data_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")
comp_data = data.frame(time = sim_data_S_over_N_median$time,
sim_data_median = sim_data_S_over_N_median$S_over_N,
sim_data_low_Q = sim_data_S_over_N_quant$S_over_N$Q2.5,
sim_data_high_Q = sim_data_S_over_N_quant$S_over_N$Q97.5)
comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
"sim_data_high_Q"))
p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
ymax = sim_data_high_Q), fill = "grey70") +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable), size = 3) +
rahul_theme +
theme_white_background +
median_legend_lab + rahul_man_figure_theme +
xlab("Days since March 1, 2020")+
ylab("S over N")
p
png("../Figures/MIF_local_test_results/N_12_Model_sim_test_params_S_over_N.png")
print(p)
dev.off()## quartz_off_screen
## 2###Diagnostic Plotting
state_var_list = colnames(sim_data)
combined_sim_var_df = data.frame(matrix(nrow = 0, ncol = 5))
colnames(combined_sim_var_df) = c("time", "median", "low_Q", "high_Q",
"var")
for(var_index in seq(from = 3, to = length(state_var_list))){
single_var = state_var_list[var_index]
#print(single_var)
single_var_data = dplyr::select(sim_data,
time,
.id,
target_var = single_var)
single_var_df = single_var_data %>%
group_by(time)%>%
summarize(median = median(target_var),
low_Q = quantile(target_var, 0.025),
high_Q = quantile(target_var, 0.975)) %>%
as.data.frame() %>%
mutate(var = single_var)
combined_sim_var_df = rbind(combined_sim_var_df, single_var_df)
}## Note: Using an external vector in selections is ambiguous.
## ℹ Use `all_of(single_var)` instead of `single_var` to silence this message.
## ℹ See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session. epi_comp_list = c("S", "E_1","I_P","I_S_1", "I_S_2", "I_A", "I_H", "R_A", "R_F", "R_H", "A_T", "beta")
S_Comp_only = combined_sim_var_df %>%
filter(var %in% epi_comp_list)
p = ggplot(data = S_Comp_only) +
geom_ribbon(aes(x = time, ymin = low_Q,
ymax = high_Q), fill = "grey70") +
geom_line(aes(x = time, y = median, color = 'red')) +
geom_point(aes(x = time, y = median, color = 'red')) +
rahul_theme +
theme_white_background +
median_legend_lab +
xlab("Days since March 1, 2020")+
ylab("State variable value") +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
facet_wrap(~var, scales = "free_y") +
geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
theme(legend.position = "none")
p
Accum_and_pop_var_list = c("C_Q1", "C_Q2","C_QNC",
"C_Q3","C_Q4",
"Y_sum", "N", "G_w_y")
Accum_and_pop_var_only = combined_sim_var_df %>%
filter(var %in% Accum_and_pop_var_list)
p = ggplot(data = Accum_and_pop_var_only) +
geom_ribbon(aes(x = time, ymin = low_Q,
ymax = high_Q), fill = "grey70") +
geom_line(aes(x = time, y = median, color = 'red')) +
geom_point(aes(x = time, y = median, color = 'red')) +
rahul_theme +
theme_white_background +
median_legend_lab +
xlab("Days since March 1, 2020")+
ylab("State variable value") +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
facet_wrap(~var, scales = "free_y") +
theme(legend.position = "none")
p
Queue_comp_list = c("Backlog_Queue_1", "Backlog_Queue_NC", "Q_2","Backlog_Queue_3", "Q_4",
"neg_samples_Q1", "neg_samples_Q3", "total_neg_samples_all_queues", "L_int")
Queue_Comp_only = combined_sim_var_df %>%
filter(var %in% Queue_comp_list)
p = ggplot(data = Queue_Comp_only) +
geom_ribbon(aes(x = time, ymin = low_Q,
ymax = high_Q), fill = "grey70") +
geom_line(aes(x = time, y = median, color = 'red')) +
geom_point(aes(x = time, y = median, color = 'red')) +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
rahul_theme +
theme_white_background +
median_legend_lab +
xlab("Days since March 1, 2020")+
ylab("State variable value") +
facet_wrap(~var, scales = "free_y") +
theme(legend.position = "none")
p
flag_list = c( "Neg_State_Value_Detected",
"NAN_State_Value_Detected",
"Error_Printing_Complete")
flag_only = combined_sim_var_df %>%
filter(var %in% flag_list)
p = ggplot(data = flag_only) +
geom_ribbon(aes(x = time, ymin = low_Q,
ymax = high_Q), fill = "grey70") +
geom_line(aes(x = time, y = median, color = 'red')) +
geom_point(aes(x = time, y = median, color = 'red')) +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
rahul_theme +
theme_white_background +
median_legend_lab +
xlab("Days since March 1, 2020")+
ylab("State variable value") +
facet_wrap(~var, scales = "free_y") +
theme(legend.position = "none")
p
backlog_var_list = c( "Backlog_Queue_1",
"total_samples_for_PCR_Testing_backlog_Q1",
"total_samples_for_PCR_Testing_backlog_lag_1_Q1",
"total_samples_for_PCR_Testing_backlog_lag_2_Q1",
"Backlog_Queue_NC",
"total_samples_for_PCR_Testing_backlog_QNC",
"total_samples_for_PCR_Testing_backlog_lag_1_QNC",
"total_samples_for_PCR_Testing_backlog_lag_2_QNC",
"Backlog_Queue_3",
"total_samples_for_PCR_Testing_backlog_Q3",
"total_samples_for_PCR_Testing_backlog_lag_1_Q3",
"total_samples_for_PCR_Testing_backlog_lag_2_Q3")
backlog_var_only = combined_sim_var_df %>%
filter(var %in% backlog_var_list)
p = ggplot(data = backlog_var_only) +
geom_ribbon(aes(x = time, ymin = low_Q,
ymax = high_Q), fill = "grey70") +
geom_line(aes(x = time, y = median, color = 'red')) +
geom_point(aes(x = time, y = median, color = 'red')) +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
rahul_theme +
theme_white_background +
median_legend_lab +
xlab("Backlog Variables Only -Days since March 1, 2020")+
ylab("State variable value") +
facet_wrap(~var, scales = "free_y") +
theme(legend.position = "none")
p
queues_2_and_4_var_list = c("C_Q2","Q_2",
"total_samples_for_PCR_Testing_Q2",
"C_Q4", "Q_4",
"total_samples_for_PCR_Testing_Q4",
"Y_Q5", "neg_samples_Q5", "L_4")
queues_2_and_4_var_only = combined_sim_var_df %>%
filter(var %in% queues_2_and_4_var_list)
p = ggplot(data = queues_2_and_4_var_only) +
geom_ribbon(aes(x = time, ymin = low_Q,
ymax = high_Q), fill = "grey70") +
geom_line(aes(x = time, y = median, color = 'red')) +
geom_point(aes(x = time, y = median, color = 'red')) +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
rahul_theme +
theme_white_background +
median_legend_lab +
xlab("Queues 2 and 4 Variables Only -Days since March 1, 2020")+
ylab("State variable value") +
facet_wrap(~var, scales = "free_y") +
theme(legend.position = "none")
p
### Hospitalization Comparison with Syndrome Surveliance
obs_resp_synd_df_raw = read.csv(
file = "../Generated_Data/simulated_non_COVID_data.csv")
#head(obs_resp_synd_df_raw)Array diagnostic testing
Exposed state compartments
exposed_list = sprintf("E_%d",1:M)
exposed_only = combined_sim_var_df %>%
filter(var %in% exposed_list)
p = ggplot(data = exposed_only) +
geom_ribbon(aes(x = time, ymin = low_Q,
ymax = high_Q), fill = "grey70") +
geom_line(aes(x = time, y = median, color = 'red')) +
geom_point(aes(x = time, y = median, color = 'red')) +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
rahul_theme +
theme_white_background +
median_legend_lab +
xlab("Days since March 1, 2020")+
ylab("State variable value") +
facet_wrap(~var, scales = "free_y") +
theme(legend.position = "none")
p
Queue 1 Testing
Queue 1 Compartments
variables_to_loop_through = c("Q_1_","P_Q1_",
"total_samples_for_PCR_Testing_Q1_",
"total_samples_for_PCR_Testing_lag_1_Q1_",
"total_samples_for_PCR_Testing_lag_2_Q1_",
"Y_Q1_",
"Q_NC_",
"total_samples_for_PCR_Testing_QNC_",
"total_samples_for_PCR_Testing_lag_1_QNC_",
"total_samples_for_PCR_Testing_lag_2_QNC_",
"Y_QNC_",
"Q_3_",
"P_Q3_",
"total_samples_for_PCR_Testing_Q3_",
"total_samples_for_PCR_Testing_lag_1_Q3_",
"total_samples_for_PCR_Testing_lag_2_Q3_",
"Y_Q3_")
Array_size_list = c(rep(V, 11), rep(K,6))
plot_array_var = function(array_var, Array_size){
single_var_array_list = sprintf(paste0(array_var,"%d"),1:Array_size)
array_vars_only = combined_sim_var_df %>%
filter(var %in% single_var_array_list)
p = ggplot(data = array_vars_only) +
geom_ribbon(aes(x = time, ymin = low_Q,
ymax = high_Q), fill = "grey70") +
geom_line(aes(x = time, y = median, color = 'red')) +
geom_point(aes(x = time, y = median, color = 'red')) +
geom_vline(xintercept = quarantine_start_time, color = 'blue') +
geom_vline(xintercept = social_distancing_start_time, color = 'orange') +
rahul_theme +
theme_white_background +
median_legend_lab +
xlab(paste0(array_var,"-","Days since March 1, 2020"))+
ylab("State variable value") +
facet_wrap(~var, scales = "free_y") +
theme(legend.position = "none")
print(p)
}
for(array_var_index in seq(1:length(variables_to_loop_through))){
plot_array_var(array_var = variables_to_loop_through[array_var_index],
Array_size = Array_size_list[array_var_index])
}
Queue 1 Passage Check
total_cases_entering_Q1 = sim_data %>%
dplyr::select(time,.id,C_Q1, Y_sum, neg_samples_Q1, Q_1_2,
Q_1_3, Q_1_13,
total_samples_for_PCR_Testing_Q1_1,
total_samples_for_PCR_Testing_Q1_2,
total_samples_for_PCR_Testing_Q1_3,
total_samples_for_PCR_Testing_Q1_4,
total_samples_for_PCR_Testing_Q1_5,
total_samples_for_PCR_Testing_Q1_6,
total_samples_for_PCR_Testing_Q1_7,
total_samples_for_PCR_Testing_Q1_8,
total_samples_for_PCR_Testing_Q1_9,
total_samples_for_PCR_Testing_Q1_10,
total_samples_for_PCR_Testing_Q1_11,
total_samples_for_PCR_Testing_Q1_12,
total_samples_for_PCR_Testing_Q1_13,
total_samples_for_PCR_Testing_backlog_Q1) %>%
group_by(.id) %>%
summarize(total_cases_entering_Q1 = sum(C_Q1),
total_cases_tested_in_first_cohort = sum(total_samples_for_PCR_Testing_Q1_1),
total_cases_with_at_least_two_cohorts = sum(Q_1_2),
total_cases_tested_in_second_cohort = sum(total_samples_for_PCR_Testing_Q1_2),
total_cases_with_at_least_three_cohorts = sum(Q_1_3),
total_cases_tested_in_3_cohort = sum(total_samples_for_PCR_Testing_Q1_3),
total_cases_tested_in_4_cohort = sum(total_samples_for_PCR_Testing_Q1_4),
total_cases_tested_in_5_cohort = sum(total_samples_for_PCR_Testing_Q1_5),
total_cases_tested_in_6_cohort = sum(total_samples_for_PCR_Testing_Q1_6),
total_cases_tested_in_7_cohort = sum(total_samples_for_PCR_Testing_Q1_7),
total_cases_tested_in_8_cohort = sum(total_samples_for_PCR_Testing_Q1_8),
total_cases_tested_in_9_cohort = sum(total_samples_for_PCR_Testing_Q1_9),
total_cases_tested_in_10_cohort = sum(total_samples_for_PCR_Testing_Q1_10),
total_cases_tested_in_11_cohort = sum(total_samples_for_PCR_Testing_Q1_11),
total_cases_tested_in_12_cohort = sum(total_samples_for_PCR_Testing_Q1_12),
total_cases_tested_in_13_cohort = sum(total_samples_for_PCR_Testing_Q1_13),
total_cases_tested_from_backlog = sum(total_samples_for_PCR_Testing_backlog_Q1),
total_cases_with_at_least_thirteen_cohorts = sum(Q_1_13),
true_positives_from_Q1 = sum(Y_sum),
false_negatives_from_Q1 = sum(neg_samples_Q1)) %>%
as.data.frame() %>%
mutate(total_cases_leaving_Q1 = true_positives_from_Q1 +
false_negatives_from_Q1,
total_cases_in_queue_after_one_cohort = total_cases_tested_in_first_cohort +
total_cases_with_at_least_two_cohorts,
total_cases_in_queue_after_two_cohorts = total_cases_tested_in_first_cohort +
total_cases_tested_in_second_cohort +total_cases_with_at_least_three_cohorts,
total_cases_in_queue_after_12_cohorts =total_cases_tested_in_first_cohort +
total_cases_tested_in_second_cohort +
total_cases_tested_in_3_cohort +
total_cases_tested_in_4_cohort +
total_cases_tested_in_5_cohort +
total_cases_tested_in_6_cohort +
total_cases_tested_in_7_cohort +
total_cases_tested_in_8_cohort +
total_cases_tested_in_9_cohort +
total_cases_tested_in_10_cohort +
total_cases_tested_in_11_cohort +
total_cases_tested_in_12_cohort +
total_cases_with_at_least_thirteen_cohorts,
total_cases_tested_in_queue_including_from_backlog =
total_cases_tested_in_first_cohort +
total_cases_tested_in_second_cohort +
total_cases_tested_in_3_cohort +
total_cases_tested_in_4_cohort +
total_cases_tested_in_5_cohort +
total_cases_tested_in_6_cohort +
total_cases_tested_in_7_cohort +
total_cases_tested_in_8_cohort +
total_cases_tested_in_9_cohort +
total_cases_tested_in_10_cohort +
total_cases_tested_in_11_cohort +
total_cases_tested_in_12_cohort +
total_cases_tested_in_13_cohort +
total_cases_tested_from_backlog) %>%
mutate(overall_queue_gap = total_cases_entering_Q1-total_cases_leaving_Q1,
gap_after_first_cohort = total_cases_entering_Q1 - total_cases_in_queue_after_one_cohort,
gap_after_second_cohort = total_cases_entering_Q1 - total_cases_in_queue_after_two_cohorts,
gap_after_12_cohorts = total_cases_entering_Q1 - total_cases_in_queue_after_12_cohorts,
gap_after_all_compartments = total_cases_entering_Q1 - total_cases_tested_in_queue_including_from_backlog)
#total_cases_entering_Q1total_cases_entering_Q1 = sim_data %>%
dplyr::select(time,.id,C_Q1, Y_sum, neg_samples_Q1, Q_1_2,
Q_1_3, Q_1_13,
total_samples_for_PCR_Testing_lag_2_Q1_1,
total_samples_for_PCR_Testing_lag_2_Q1_2,
total_samples_for_PCR_Testing_lag_2_Q1_3,
total_samples_for_PCR_Testing_lag_2_Q1_4,
total_samples_for_PCR_Testing_lag_2_Q1_5,
total_samples_for_PCR_Testing_lag_2_Q1_6,
total_samples_for_PCR_Testing_lag_2_Q1_7,
total_samples_for_PCR_Testing_lag_2_Q1_8,
total_samples_for_PCR_Testing_lag_2_Q1_9,
total_samples_for_PCR_Testing_lag_2_Q1_10,
total_samples_for_PCR_Testing_lag_2_Q1_11,
total_samples_for_PCR_Testing_lag_2_Q1_12,
total_samples_for_PCR_Testing_lag_2_Q1_13,
total_samples_for_PCR_Testing_backlog_lag_2_Q1) %>%
group_by(.id) %>%
summarize(total_cases_entering_Q1 = sum(C_Q1),
total_cases_tested_in_first_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_1),
total_cases_with_at_least_two_cohorts = sum(Q_1_2),
total_cases_tested_in_second_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_2),
total_cases_with_at_least_three_cohorts = sum(Q_1_3),
total_cases_tested_in_3_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_3),
total_cases_tested_in_4_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_4),
total_cases_tested_in_5_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_5),
total_cases_tested_in_6_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_6),
total_cases_tested_in_7_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_7),
total_cases_tested_in_8_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_8),
total_cases_tested_in_9_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_9),
total_cases_tested_in_10_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_10),
total_cases_tested_in_11_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_11),
total_cases_tested_in_12_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_12),
total_cases_tested_in_13_cohort = sum(total_samples_for_PCR_Testing_lag_2_Q1_13),
total_cases_tested_from_backlog = sum(total_samples_for_PCR_Testing_backlog_lag_2_Q1),
total_cases_with_at_least_thirteen_cohorts = sum(Q_1_13),
true_positives_from_Q1 = sum(Y_sum),
false_negatives_from_Q1 = sum(neg_samples_Q1)) %>%
as.data.frame() %>%
mutate(total_cases_leaving_Q1 = true_positives_from_Q1 +
false_negatives_from_Q1,
total_cases_in_queue_after_one_cohort = total_cases_tested_in_first_cohort +
total_cases_with_at_least_two_cohorts,
total_cases_in_queue_after_two_cohorts = total_cases_tested_in_first_cohort +
total_cases_tested_in_second_cohort +total_cases_with_at_least_three_cohorts,
total_cases_in_queue_after_12_cohorts =total_cases_tested_in_first_cohort +
total_cases_tested_in_second_cohort +
total_cases_tested_in_3_cohort +
total_cases_tested_in_4_cohort +
total_cases_tested_in_5_cohort +
total_cases_tested_in_6_cohort +
total_cases_tested_in_7_cohort +
total_cases_tested_in_8_cohort +
total_cases_tested_in_9_cohort +
total_cases_tested_in_10_cohort +
total_cases_tested_in_11_cohort +
total_cases_tested_in_12_cohort +
total_cases_with_at_least_thirteen_cohorts,
total_cases_tested_in_queue_including_from_backlog =
total_cases_tested_in_first_cohort +
total_cases_tested_in_second_cohort +
total_cases_tested_in_3_cohort +
total_cases_tested_in_4_cohort +
total_cases_tested_in_5_cohort +
total_cases_tested_in_6_cohort +
total_cases_tested_in_7_cohort +
total_cases_tested_in_8_cohort +
total_cases_tested_in_9_cohort +
total_cases_tested_in_10_cohort +
total_cases_tested_in_11_cohort +
total_cases_tested_in_12_cohort +
total_cases_tested_in_13_cohort +
total_cases_tested_from_backlog) %>%
mutate(overall_queue_gap = total_cases_entering_Q1-total_cases_leaving_Q1,
gap_after_first_cohort = total_cases_entering_Q1 - total_cases_in_queue_after_one_cohort,
gap_after_second_cohort = total_cases_entering_Q1 - total_cases_in_queue_after_two_cohorts,
gap_after_12_cohorts = total_cases_entering_Q1 - total_cases_in_queue_after_12_cohorts,
gap_after_all_compartments = total_cases_entering_Q1 - total_cases_tested_in_queue_including_from_backlog)
#total_cases_entering_Q1Check end of first sim run
sim_data_first_run_only = sim_data %>%
filter(.id == 1)
#head(sim_data_first_run_only)
sim_data_first_run_only$total_samples_for_PCR_Testing_lag_1_Q1_1[nrow(sim_data_first_run_only)]## [1] 196sim_data_first_run_only$total_samples_for_PCR_Testing_Q1_1[nrow(sim_data_first_run_only)]## [1] 196sim_data_first_run_only$total_samples_for_PCR_Testing_lag_2_Q1_1[nrow(sim_data_first_run_only)]## [1] 163sim_data_waiting_for_testing_at_end = sim_data %>%
dplyr::select(time, .id, total_samples_for_PCR_Testing_lag_1_Q1_1,
total_samples_for_PCR_Testing_lag_2_Q1_1) %>%
filter(time == max(sim_data$time)) %>%
mutate(total_waiting_for_testing = total_samples_for_PCR_Testing_lag_1_Q1_1 +
total_samples_for_PCR_Testing_lag_2_Q1_1) %>%
dplyr::select(.id, total_waiting_for_testing)
total_cases_entering_Q1_with_adj = join(total_cases_entering_Q1,
sim_data_waiting_for_testing_at_end)## Joining by: .idtotal_cases_entering_Q1_with_adj_summary_df = total_cases_entering_Q1_with_adj %>%
mutate(gap_adjusted_for_waiting = overall_queue_gap - total_waiting_for_testing) %>%
dplyr::select(.id, total_cases_entering_Q1, true_positives_from_Q1, false_negatives_from_Q1,
overall_queue_gap, total_waiting_for_testing, gap_adjusted_for_waiting)
#total_cases_entering_Q1_with_adj_summary_df
sum(total_cases_entering_Q1_with_adj_summary_df$gap_adjusted_for_waiting)## [1] -15489245Updated test
sim_data_first_run_only = sim_data %>%
filter(.id == 1)
total_postive_cases_leaving_Q1 = sum(sim_data_first_run_only$Y_Q1_1 +
sim_data_first_run_only$Y_Q1_2 +
sim_data_first_run_only$Y_Q1_3 +
sim_data_first_run_only$Y_Q1_4 +
sim_data_first_run_only$Y_Q1_5 +
sim_data_first_run_only$Y_Q1_6 +
sim_data_first_run_only$Y_Q1_7 +
sim_data_first_run_only$Y_Q1_8 +
sim_data_first_run_only$Y_Q1_9 +
sim_data_first_run_only$Y_Q1_10 +
sim_data_first_run_only$Y_Q1_11 +
sim_data_first_run_only$Y_Q1_12 +
sim_data_first_run_only$Y_Q1_13 +
sim_data_first_run_only$Y_Q1_backlog)
total_cases_entering_Q1_first_run_only = sum(sim_data_first_run_only$C_Q1)
gap = total_cases_entering_Q1_first_run_only - sum(sim_data_first_run_only$neg_samples_Q1) - total_postive_cases_leaving_Q1
gap## [1] 359waiting_to_be_tested = sim_data_first_run_only$total_samples_for_PCR_Testing_Q1_1[nrow(sim_data_first_run_only)] + sim_data_first_run_only$total_samples_for_PCR_Testing_Q1_2[nrow(sim_data_first_run_only)] +sim_data_first_run_only$total_samples_for_PCR_Testing_lag_1_Q1_1[nrow(sim_data_first_run_only)]
gap_taking_into_account_waiting = gap - waiting_to_be_tested
gap_taking_into_account_waiting## [1] -33Queue 2 Diagnostic Test
gap_check_Q2 = sim_data %>%
dplyr::select(time, .id, total_samples_for_PCR_Testing_Q2, C_Q2) %>%
group_by(.id) %>%
summarize(total_samples_entering_Q2 = sum(C_Q2),
total_samples_exiting_Q2 =
sum(total_samples_for_PCR_Testing_Q2)) %>%
as.data.frame() %>%
mutate(Q2_gap = total_samples_entering_Q2 - total_samples_exiting_Q2)
#gap_check_Q2
sum(gap_check_Q2$Q2_gap)## [1] 0Queue 3 Diagnostic Tests
Queue 4 Diagnostic Test
gap_check_Q4 = sim_data %>%
dplyr::select(time, .id, total_samples_for_PCR_Testing_Q4, C_Q4) %>%
group_by(.id) %>%
summarize(total_samples_entering_Q4 = sum(C_Q4),
total_samples_exiting_Q4 =
sum(total_samples_for_PCR_Testing_Q4)) %>%
as.data.frame() %>%
mutate(Q4_gap = total_samples_entering_Q4 - total_samples_exiting_Q4)
#gap_check_Q4
sum(gap_check_Q4$Q4_gap)## [1] 0Filter a simulation
single_sim_df= filter(sim_data, .id == 1)
pfilter_sim_data = dplyr::select(single_sim_df, time = time, Y = Y,
obs_prop_positive = obs_prop_positive)
p = ggplot(data = pfilter_sim_data,(aes(x = time, y = Y))) + geom_point() + geom_line() + rahul_theme + xlab("Days since March 1, 2020")
p
p = ggplot(data = pfilter_sim_data,(aes(x = time, y = obs_prop_positive))) + geom_point() + geom_line() + rahul_theme + xlab("Days since March 1, 2020")
p
ptm <- proc.time()
pfilter_sim_output = pfilter(data = pfilter_sim_data,
seed = 12345,
times = pfilter_sim_data$time,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
format = "data.frame",
Np = 1000)## in 'pomp': the unrecognized arguments 'seed','rmeas','format' are available for use by the POMP basic components.## Warning: in 'pfilter': the 'tol' argument is deprecated and will be removed in a future release.
## Currently, the default value of 'tol' is 1e-17;
## in future releases, the value will be 0, and the option to choose otherwise will be removed.proc.time() - ptm## user system elapsed
## 2.508 0.583 3.527plot(pfilter_sim_output)
logLik(pfilter_sim_output)## [1] -619.8805eff.sample.size(pfilter_sim_output)## [1] 1000.0000 1000.0000 445.0944 806.3391 839.9178 951.8376 791.4231
## [8] 651.0750 747.5932 865.7492 963.1070 971.1709 949.9457 916.9502
## [15] 991.6011 998.7109 995.4614 993.4279 983.7052 996.9354 998.4380
## [22] 999.7335 993.5954 995.5388 999.9463 997.9813 999.9458 999.1030
## [29] 999.4807 999.5533 998.2634 999.6745 999.3151 999.9865 999.8749
## [36] 999.4083 998.7752 999.8315 999.6843 999.6038 999.5162 997.9552
## [43] 998.9959 991.6500 999.4123 995.6255 995.0936 990.5486 996.7308
## [50] 999.1606 985.0372 999.7668 998.0056 999.2042 976.2250 999.9770
## [57] 996.3924 999.8493 999.9750 995.4557 999.6128 998.9906 989.8396
## [64] 993.3976 995.0472 964.7968 996.9661 999.4780 998.3215 999.9253
## [71] 995.3254 988.5053 992.6538 999.8708 987.7947 998.1912 993.9179
## [78] 990.4168 999.2281 986.4045 975.0919 931.9336 996.8863 997.6826
## [85] 983.5389 999.5217 855.7992 938.6596 899.8705cond.logLik(pfilter_sim_output)## [1] -0.0996888 -0.0996888 -1.6014417 -1.5603741 -2.9140205
## [6] -2.6810393 -3.5742851 -3.4167295 -4.5564862 -3.7689503
## [11] -3.5242127 -4.3737378 -4.9297827 -4.8210436 -5.3802376
## [16] -5.5714730 -6.7799888 -8.1514761 -7.7823885 -7.1149598
## [21] -7.4189653 -7.4636202 -8.3622096 -8.0616814 -7.9019476
## [26] -8.5265603 -8.2613534 -9.1266805 -8.1873876 -8.9168916
## [31] -9.5367348 -8.2772934 -9.2671552 -8.6145081 -8.3689406
## [36] -8.3560103 -8.8453097 -8.6766441 -8.5786797 -8.1568687
## [41] -8.2958025 -8.5240869 -7.7722498 -8.0983524 -8.4671907
## [46] -8.6923872 -8.3761936 -9.0907251 -8.0195612 -7.3966297
## [51] -9.4945239 -7.7355560 -7.6747398 -7.5516357 -10.3037134
## [56] -7.4721719 -7.8821476 -7.3620408 -7.3465122 -7.4517056
## [61] -7.2178469 -7.1755240 -7.8981710 -7.6406247 -7.1538219
## [66] -9.3061141 -7.2397546 -6.9898422 -7.0253577 -6.8285866
## [71] -6.8247090 -7.3735068 -6.7937543 -6.6391634 -7.1739838
## [76] -6.6625322 -6.5307768 -6.5572282 -6.4515142 -6.5257405
## [81] -6.7831274 -8.0632408 -6.1698693 -6.1136348 -6.2755794
## [86] -6.0304933 -8.8018057 -6.9444475 -8.0743323Pfilter real data with 1 particle
ptm <- proc.time()
pfilter_real_output= pfilter(data = Observed_data,
seed = 12345,
times = Observed_data$times,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
format = "data.frame",
Np = 1)## in 'pomp': the unrecognized arguments 'seed','rmeas','format' are available for use by the POMP basic components.## Warning: in 'pfilter': the 'tol' argument is deprecated and will be removed in a future release.
## Currently, the default value of 'tol' is 1e-17;
## in future releases, the value will be 0, and the option to choose otherwise will be removed.proc.time() - ptm## user system elapsed
## 1.290 0.166 1.612#plot(pfilter_real_output)
logLik(pfilter_real_output)## [1] -656.06eff.sample.size(pfilter_real_output)## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [36] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [71] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1cond.logLik(pfilter_real_output)## [1] -0.0996888 -0.0996888 -1.5575114 -1.5575114 -2.6324918
## [6] -9.5703912 -8.1391403 -3.2008993 -4.4163017 -7.5721704
## [11] -3.9681679 -4.2271664 -7.4388148 -5.6908388 -5.7467568
## [16] -8.9335143 -6.6190591 -7.8031883 -7.2433216 -9.0327853
## [21] -9.1927987 -7.4038037 -7.5679020 -7.7149145 -7.8760283
## [26] -8.0783886 -8.8504392 -9.2896901 -8.3860804 -10.4903153
## [31] -8.4822597 -8.1768145 -8.5512105 -11.4881271 -8.3395325
## [36] -8.3632062 -8.5564836 -9.0593680 -8.8208694 -8.2679806
## [41] -8.0948038 -8.7789376 -7.8677172 -15.9592893 -8.6086934
## [46] -7.9129879 -7.9199021 -8.2667359 -9.0170702 -7.3939641
## [51] -8.0158015 -7.7359552 -9.2670415 -9.2927665 -7.6850939
## [56] -7.5930121 -7.8614381 -7.3702979 -7.4633016 -7.2569890
## [61] -7.7007299 -7.1743075 -7.9890724 -7.9733924 -7.1672057
## [66] -7.0866474 -6.9143908 -6.9022708 -7.0793853 -7.5881226
## [71] -8.4467497 -6.7425683 -6.7421333 -8.7376917 -6.7070505
## [76] -6.5815158 -7.8466361 -7.7949580 -6.4270810 -7.3305161
## [81] -6.3245562 -6.2099440 -6.3488905 -6.1274463 -6.0447130
## [86] -6.0656281 -9.0674259 -8.5033952 -6.5681625Pfilter real data with 1000 particles
ptm <- proc.time()
pfilter_real_output = pfilter(data = Observed_data,
seed = 12345,
times = Observed_data$times,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
format = "data.frame",
Np = 1000,
save.state = TRUE,
filter.mean = TRUE,
pred.mean = TRUE,
pred.var = TRUE)## in 'pomp': the unrecognized arguments 'seed','rmeas','format' are available for use by the POMP basic components.## Warning: in 'pfilter': the 'tol' argument is deprecated and will be removed in a future release.
## Currently, the default value of 'tol' is 1e-17;
## in future releases, the value will be 0, and the option to choose otherwise will be removed.proc.time() - ptm## user system elapsed
## 3.096 0.543 3.923#plot(pfilter_real_output)
logLik(pfilter_real_output)## [1] -650.361eff.sample.size(pfilter_real_output)## [1] 1000.00000 1000.00000 904.21247 905.12206 882.65269 81.95542
## [7] 183.10539 867.70143 772.29892 367.68966 964.25003 961.58667
## [13] 779.52747 869.20491 912.14882 865.22536 998.30093 993.02511
## [19] 992.35654 964.31565 971.40173 999.95757 999.84012 999.87640
## [25] 999.56429 998.88727 995.10393 998.79528 999.64467 998.50544
## [31] 999.38302 999.91985 999.77392 998.32160 999.43074 999.39260
## [37] 999.30774 998.95741 997.76536 999.77828 999.63257 994.58293
## [43] 997.45701 841.97985 992.93363 999.70589 999.45928 996.77832
## [49] 989.27901 999.58900 997.07736 998.76184 985.71180 978.75134
## [55] 999.54431 996.34537 991.31436 999.94921 999.20837 999.72865
## [61] 995.32723 999.50187 985.67393 982.47749 995.30927 999.25973
## [67] 999.53672 999.65472 989.64580 981.24710 961.99946 996.37686
## [73] 999.49718 943.09803 997.29788 998.69752 963.65109 959.77001
## [79] 987.32856 977.84614 999.54738 999.69801 995.23191 991.87197
## [85] 989.48573 999.57449 823.87025 879.74127 961.26894cond.logLik(pfilter_real_output)## [1] -0.0996888 -0.0996888 -1.6296532 -1.6182096 -2.4677670
## [6] -7.8545345 -5.5010505 -2.9678209 -3.7614727 -7.6035911
## [11] -3.7004243 -4.4303979 -7.3227860 -5.4257297 -5.8331570
## [16] -8.4474750 -6.6793799 -7.8331933 -7.2311503 -9.0474416
## [21] -9.1388826 -7.4081843 -7.5473535 -7.7272114 -7.8950636
## [26] -8.1069147 -8.8933455 -9.2414363 -8.3827565 -10.5352930
## [31] -8.4566924 -8.1798816 -8.5231907 -11.4544999 -8.3403410
## [36] -8.3666327 -8.5297049 -9.0431425 -8.7856148 -8.2444261
## [41] -8.1000160 -8.7124006 -7.9318009 -16.2274518 -8.7643879
## [46] -7.9247785 -7.8903203 -8.1049324 -9.0451624 -7.3986919
## [51] -7.9858124 -7.7255545 -9.1396365 -9.5292655 -7.6363223
## [56] -7.6348130 -8.0222457 -7.3723155 -7.4719085 -7.2657004
## [61] -7.7179577 -7.1685037 -7.9642971 -8.0420821 -7.1790354
## [66] -7.1172790 -6.9301812 -6.8830019 -7.1733863 -7.6208234
## [71] -8.3690967 -6.7356032 -6.7312867 -8.6848287 -6.7565806
## [76] -6.4986193 -7.4844904 -7.5673599 -6.5579830 -7.0833488
## [81] -6.2614838 -6.2222372 -6.4248238 -6.1907111 -6.1649583
## [86] -6.0673546 -9.3192409 -8.3561269 -6.8495809Pfilter real data with 1000 particles
ptm <- proc.time()
pfilter_real_output = pfilter(data = Observed_data,
seed = 12345,
times = Observed_data$times,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
format = "data.frame",
Np = 1000,
save.state = TRUE,
filter.mean = TRUE,
pred.mean = TRUE,
pred.var = TRUE)## in 'pomp': the unrecognized arguments 'seed','rmeas','format' are available for use by the POMP basic components.## Warning: in 'pfilter': the 'tol' argument is deprecated and will be removed in a future release.
## Currently, the default value of 'tol' is 1e-17;
## in future releases, the value will be 0, and the option to choose otherwise will be removed.proc.time() - ptm## user system elapsed
## 2.985 0.770 4.155#plot(pfilter_real_output)
logLik(pfilter_real_output)## [1] -650.2476eff.sample.size(pfilter_real_output)## [1] 1000.00000 1000.00000 881.96619 882.68400 871.14998 46.17863
## [7] 313.07664 875.37007 828.21087 362.43061 962.75087 975.61599
## [13] 698.53285 841.47679 936.74860 849.21121 998.41249 994.51618
## [19] 993.07480 965.54899 969.65471 999.96804 999.85923 999.89075
## [25] 999.57748 998.88149 995.31299 998.72041 999.65667 998.51662
## [31] 999.34739 999.92204 999.76187 998.07473 999.46438 999.40365
## [37] 999.30108 998.90329 997.08712 999.78245 999.61515 994.71138
## [43] 997.48566 840.01893 992.61719 999.69111 999.43784 996.88013
## [49] 989.16706 999.54252 996.92531 998.93606 985.80829 977.29572
## [55] 999.48572 995.90361 990.12075 999.95467 999.23060 999.72818
## [61] 995.13555 999.45319 985.32393 984.71679 994.66261 999.19450
## [67] 999.48382 999.62554 988.76984 979.03153 964.78394 996.41484
## [73] 999.51720 942.61482 997.44385 998.77555 963.92726 962.34544
## [79] 988.85481 978.47426 999.50685 999.70728 994.32946 991.96463
## [85] 990.96789 999.56345 817.95069 874.97796 957.77632cond.logLik(pfilter_real_output)## [1] -0.0996888 -0.0996888 -1.6576759 -1.6563828 -2.5059396
## [6] -7.7487636 -5.6055614 -3.0270312 -3.6571921 -7.2772745
## [11] -3.7091475 -4.4096709 -7.3437408 -5.5220994 -5.7996460
## [16] -8.4979648 -6.6742935 -7.8243265 -7.2335099 -9.0600520
## [21] -9.1538663 -7.4079098 -7.5466969 -7.7252836 -7.8938241
## [26] -8.1048448 -8.8837499 -9.2446580 -8.3834299 -10.5372758
## [31] -8.4597521 -8.1802061 -8.5248938 -11.4599008 -8.3421370
## [36] -8.3670348 -8.5301977 -9.0463584 -8.7814696 -8.2470950
## [41] -8.1010661 -8.7106924 -7.9254865 -16.1528567 -8.7508158
## [46] -7.9236218 -7.8895324 -8.1024352 -9.0363974 -7.3997537
## [51] -7.9946980 -7.7219663 -9.1420769 -9.5423763 -7.6373501
## [56] -7.6316550 -8.0183330 -7.3720843 -7.4747742 -7.2659413
## [61] -7.7222992 -7.1690725 -7.9539812 -8.0368317 -7.1787135
## [66] -7.1171228 -6.9294598 -6.8815158 -7.1703971 -7.6150029
## [71] -8.3811377 -6.7298914 -6.7314007 -8.7159851 -6.7579677
## [76] -6.4965953 -7.4881491 -7.5703407 -6.5498441 -7.0888263
## [81] -6.2622165 -6.2227362 -6.4306016 -6.1906017 -6.1656912
## [86] -6.0672778 -9.3699539 -8.3683263 -6.8615397Analysis
filter_mean_mat = pfilter_real_output@filter.mean
filter_mean_df = filter_mean_mat%>%
t() %>%
as.data.frame()
#head(filter_mean_df)
filter_mean_df$times = filter_mean_mat %>%
colnames() %>% as.numeric()
Y_sum_filter_mean = filter_mean_df %>%
dplyr::select(times, Y_sum)
pred_var_df = pfilter_real_output@pred.var %>%
t() %>%
as.data.frame()
pred_var_df$times = filter_mean_mat %>%
colnames() %>% as.numeric()
Y_sum_pred_var = pred_var_df %>%
dplyr::select(times, Y_sum_var = Y_sum)
Y_sum_filter_mean_vs_obs = join(Y_sum_filter_mean, Observed_data)## Joining by: timesY_sum_filter_mean_vs_obs = join(Y_sum_filter_mean_vs_obs, Y_sum_pred_var)## Joining by: timessize= (1/sigma_M/sigma_M)
Y_sum_filter_mean_vs_obs$Neg_binom_lik = dnbinom(Y_sum_filter_mean_vs_obs$Y, mu = Y_sum_filter_mean_vs_obs$Y_sum, size = size,
log = TRUE)
plot_data = Y_sum_filter_mean_vs_obs %>%
dplyr::select(times, Y_sum_filter_mean = Y_sum, Y) %>%
melt(id.vars = "times")
p = ggplot(data = plot_data, aes(x = times, y = log(value), color = variable)) + geom_point() +
geom_line() + rahul_theme
p
MIF to simulated data (Validation)
No truncation
mif_sim_data = pfilter_sim_data
mif_sim_file_name = paste0("../Generated_Data/MIF_local_test_results/mif_sim_test_data_", model_name, "_COVID_NYC.RData")
save(mif_sim_data,
file = mif_sim_file_name)##Plot simulated trajectory to be used for fitting
p = ggplot(data = mif_sim_data,(aes(x = time, y = Y))) + geom_point() + geom_line() + rahul_theme + xlab("Days since March 1, 2020")
p
Load parallelization libraries
library(foreach)
library(doParallel)
registerDoParallel()Run pfilter repeatedly (test paralell structure)
library(doRNG)## Loading required package: foreach##
## Attaching package: 'foreach'## The following objects are masked from 'package:purrr':
##
## accumulate, when## Loading required package: rngtools## Loading required package: pkgmaker## Loading required package: registry## Warning: package 'registry' was built under R version 3.5.2##
## Attaching package: 'pkgmaker'## The following object is masked from 'package:base':
##
## isFALSEregisterDoRNG(123456)## Warning: executing %dopar% sequentially: no parallel backend registeredptm <- proc.time()
rds_index = rds_index + 1
rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = rds_file_name,{
foreach(i=1:10, .packages = 'pomp',
.export = c("rproc", "rmeas", "dmeas", "init", "paramnames", "statenames", "obsnames",
"param_vec", "par_trans", "acumvarnames")
) %dopar% {
pfilter(data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
format = "data.frame",
covar = covar,
Np = 1000)
}
}) ->pfilter_sim_par_output
proc.time() - ptm## user system elapsed
## 0.027 0.002 0.030(L_pfilter_sim_par_output <- logmeanexp(sapply(pfilter_sim_par_output, logLik), se = TRUE))## se
## -619.85506239 0.02518861Store results of pfilter run in likelihood csv file
results <- as.data.frame(as.list(c(coef(pfilter_sim_par_output[[1]]), logLik = L_pfilter_sim_par_output[1],
loglik = L_pfilter_sim_par_output[2])))
results
result_output_file = paste0("covid_NYC_", model_name, "_sim_data_fit_params.csv")
write.csv(results, file = result_output_file, row.names = FALSE)MIF Debug Test
One mif run, one particle
test_1_mif = mif2(
data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
seed = 12345,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
start = param_vec,
covar = covar,
Np = 1,
Nmif = 1,
tol = 0,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd(phi_E = 0,
phi_U = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0))rds_index = rds_index + 1
mif_50_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = mif_50_rds_file_name,{
mif2(data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
seed = 12345,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
start = param_vec,
covar = covar,
Np = 2000,
Nmif = 50,
tol = 0,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd(phi_E = 0,
phi_U = 0,
b_p = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
)}) ->test_mif
test_mif@eff.sample.size## [1] 2000.0000 2000.0000 898.6966 1638.9455 1643.2102 1877.5360 1502.3207
## [8] 1291.6848 1351.0340 1683.6871 1889.8154 1853.2811 1855.6062 1829.0444
## [15] 1949.9009 1984.8748 1971.1070 1968.9730 1690.9300 1888.3396 1903.6966
## [22] 1957.2209 1688.5466 1621.0618 1955.7850 1844.7376 1978.9542 1991.3737
## [29] 1997.0881 1992.9166 1971.1269 1995.1720 1995.1586 1986.8976 1987.1457
## [36] 1989.6867 1951.1921 1945.1478 1875.3236 1877.3061 1945.6277 1894.0370
## [43] 1761.7161 1646.8336 1887.0374 1810.0409 1681.9470 1677.6050 1846.4189
## [50] 1720.8516 1320.7365 1681.6987 1888.8337 1959.7937 1144.3542 1969.1846
## [57] 1818.7113 1980.2179 1974.4519 1903.2429 1978.5222 1976.4605 1662.8912
## [64] 1798.1811 1897.2097 1286.7400 1858.5081 1944.4116 1920.2879 1967.0226
## [71] 1934.3111 1739.3778 1902.8327 1967.5223 1784.5653 1948.5414 1914.2711
## [78] 1885.0335 1952.0638 1870.8935 1762.2037 1410.1592 1976.0497 1971.2624
## [85] 1933.8991 1937.0207 699.1346 1647.5261 1150.1093Local MIF Search (Validation)
ptm = proc.time()
registerDoRNG(123456)
rds_index = rds_index + 1
parallel_mif_50_run_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = parallel_mif_50_run_rds_file_name,{
foreach(i=1:5,
.packages = 'pomp',
.combine = c,
.export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
"param_vec","par_trans", "acumvarnames")
) %dopar%
{
mif2(
data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
start = param_vec,
covar = covar,
Np = 2000,
Nmif = 50,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd(phi_E = 0,
phi_U = 0,
b_p = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
)
}
}) -> mifs_sim_data_local
mif_sim_local_output_file = paste0("../Generated_Data/MIF_local_test_results/", model_name, "_validation_5_mif_iterations_output.RData")
save(mifs_sim_data_local, file = mif_sim_local_output_file)
p = ggplot(data = melt(conv.rec(mifs_sim_data_local)),
aes(x = iteration, y = value, group = L1, color = factor(L1))) +
geom_line()+
guides(color=FALSE)+
facet_wrap(~variable, scales="free_y") + theme_bw()## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.p
mif_par_sim_fit_50_plot_file = paste0("../Figures/MIF_local_test_results/", model_name,
"_test_mif_convergence_dem_stoch_plot_5_runs_50_iterations_from_sim_data_truth.png")
png(mif_par_sim_fit_50_plot_file)
print(p)
dev.off()## quartz_off_screen
## 2param_list = list()
pfilter_end_mean_list = vector(length = length(mifs_sim_data_local))
pfilter_end_se_list = vector(length = length(mifs_sim_data_local))
for(run_index in seq(1:length(mifs_sim_data_local))){
print(run_index)
single_mif_run_output = mifs_sim_data_local[[run_index]]
param_list[[run_index]] = single_mif_run_output@params
mif_test_end_par = param_list[[run_index]]
#Get Final Pfilter Likelihood
registerDoRNG(123456)
ptm <- proc.time()
rds_index = rds_index + 1
bake(file = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds"),{
foreach(i=1:10, .packages = 'pomp',
.export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
"mif_test_end_par", "par_trans", "acumvarnames")
) %dopar% {
pfilter(data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = mif_test_end_par,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
format = "data.frame",
Np = 1000)
}
}) ->pfilter_sim_at_mif_end
proc.time() - ptm
pfilter_sim_at_mif_end <- logmeanexp(sapply(pfilter_sim_at_mif_end, logLik), se = TRUE)
pfilter_end_mean_list[run_index] = pfilter_sim_at_mif_end[[1]]
pfilter_end_se_list[run_index] = pfilter_sim_at_mif_end[[2]]
}## [1] 1
## [1] 2
## [1] 3
## [1] 4
## [1] 5#Get Pfilter Likelihood at Start
#registerDoRNG(123456)
ptm <- proc.time()
rds_index = rds_index + 1
pf_start_mif_sim_test_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = pf_start_mif_sim_test_rds_file_name,{
foreach(i=1:10, .packages = 'pomp',
.export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
"param_vec", "par_trans", "acumvarnames")
) %dopar% {
pfilter(data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
format = "data.frame",
Np = 1000)
}
}) ->pfilter_sim_at_mif_start
proc.time() - ptm## user system elapsed
## 0.117 0.011 0.134L_pfilter_sim_at_mif_start <- logmeanexp(sapply(pfilter_sim_at_mif_start, logLik), se = TRUE)
L_pfilter_sim_at_mif_start## se
## -619.86722850 0.03028052true_sim_mean = L_pfilter_sim_at_mif_start[[1]]
true_sim_se = L_pfilter_sim_at_mif_start[[2]]
pfilter_5_mif_data_analysis_value_storage = list(end_mean = pfilter_end_mean_list, end_se = pfilter_end_se_list, start_mean = true_sim_mean,
start_se = true_sim_se)
pfilter_5_mif_storage_file_name = paste0("../Generated_Data/MIF_local_test_results/", model_name,
"_validation_5_mif_iterations_pfitler_likelihood_ranges.RData")
save(pfilter_5_mif_data_analysis_value_storage,
file = pfilter_5_mif_storage_file_name)
plot_data = data.frame(iterations = seq(1:length(mifs_sim_data_local)), pfilter_end_mean = pfilter_end_mean_list,
pfilter_end_se = pfilter_end_se_list)
p = ggplot(data = plot_data, aes(x = iterations, y = pfilter_end_mean)) +
geom_errorbar(aes(ymin = pfilter_end_mean - pfilter_end_se,
ymax = pfilter_end_mean + pfilter_end_se)) + geom_hline(yintercept = true_sim_mean,
color = 'red')+
geom_hline(yintercept = true_sim_mean - true_sim_se, color = 'blue') +
geom_hline(yintercept = true_sim_mean + true_sim_se, color = 'blue')
p
mif_5_run_plot_file_name = paste0("../Figures/MIF_local_test_results/", model_name,
"_validation_plot_pfilter_ranges_for_5_mif_runs_of_50_iterations_blue_and_red_lines_are_pfilter_start_ranges.png")
png(mif_5_run_plot_file_name)
print(p)
dev.off()## quartz_off_screen
## 2mifs_sim_data_local[[5]]@params## M_0 V_0
## 5.000000e+00 1.300000e+01
## K_0 phi_E
## 1.400000e+01 1.090000e+00
## phi_U phi_S
## 1.090000e+00 2.000000e-01
## h_V p_S
## 7.692308e-02 1.517197e-01
## p_H_cond_S gamma
## 2.896772e-01 2.727855e-01
## quarantine_start_time social_distancing_start_time
## 2.200000e+01 1.800000e+01
## PCR_sens b_q
## 9.000000e-01 7.556507e-02
## b_a b_p
## 1.000000e+00 0.000000e+00
## R_0 E_0
## 1.154630e+01 1.412039e+04
## z_0 N_0
## 1.520000e+04 8.000000e+06
## C_0 sigma_M
## 0.000000e+00 2.489193e-01
## beta_w_3 beta_w_2
## 1.215073e-02 9.810086e-01
## beta_w_1 beta_w_0
## -3.723481e+01 2.294094e+02
## g_0 g_F
## 1.183300e+03 1.162005e-01
## sigma_epsilon G_w_y_scaling
## 1.091121e+02 1.620000e-01proc.time() - ptm## user system elapsed
## 0.821 0.071 1.013p = ggplot(data = melt(conv.rec(test_mif)),
aes(x = iteration, y = value, group = variable, color = factor(variable))) +
geom_line()+
guides(color=FALSE)+
facet_wrap(~variable, scales="free_y") + theme_bw()## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.p## Warning: Removed 2 row(s) containing missing values (geom_path).
test_mif_local_sim_results_plot_file_name = paste0("../Figures/MIF_local_test_results/", model_name,
"_test_mif_local_run_from_sim_data_true_parameters.png")
png(test_mif_local_sim_results_plot_file_name)
print(p)## Warning: Removed 2 row(s) containing missing values (geom_path).dev.off()## quartz_off_screen
## 2Get Final Pfilter Likelihood
registerDoRNG(123456)
ptm <- proc.time()
rds_index = rds_index + 1
pfilter_local_mif_test_end_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = pfilter_local_mif_test_end_rds_file_name,{
foreach(i=1:10, .packages = 'pomp',
.export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
"mif_test_end_par", "par_trans", "acumvarnames")
) %dopar% {
pfilter(data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t =1),
params = mif_test_end_par,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
tol = 0,
format = "data.frame",
Np = 1000)
}
}) ->pfilter_sim_at_mif_end
proc.time() - ptm## user system elapsed
## 0.031 0.002 0.034(L_pfilter_sim_at_mif_end <- logmeanexp(sapply(pfilter_sim_at_mif_end, logLik), se = TRUE))## se
## -621.50216222 0.02387581Plot MIF results
Really long single MIF run
One mif run, 2000 particles, 100 iterations
ptm = proc.time()
rds_index = rds_index + 1
mif_100_iteration_run_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = mif_100_iteration_run_rds_file_name,{
mif2(
data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
seed = 12345,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
tol = 0,
start = param_vec,
Np = 2000,
Nmif = 100,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd(phi_E = 0,
phi_U = 0,
b_p = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
)
}) -> long_mif_output
proc.time() - ptm## user system elapsed
## 0.010 0.002 0.013long_mif_output@eff.sample.size## [1] 2000.0000 2000.0000 873.6788 1632.9889 1699.4831 1872.1854 1535.8886
## [8] 1273.2367 1393.0701 1709.2488 1902.4866 1876.9859 1887.3468 1832.9102
## [15] 1953.5875 1990.1156 1976.1851 1979.5519 1819.6276 1948.0816 1969.6096
## [22] 1985.6969 1856.8849 1830.5027 1984.0650 1929.2043 1990.1514 1995.9555
## [29] 1997.6243 1995.6620 1984.2489 1997.1060 1996.1527 1993.6222 1993.3058
## [36] 1993.4411 1968.1376 1971.7515 1906.2634 1853.9637 1965.7189 1938.7431
## [43] 1926.9833 1647.2647 1940.0775 1886.5384 1800.7595 1779.2620 1899.8063
## [50] 1932.0205 1631.1786 1845.8441 1940.3707 1975.3675 1381.6876 1989.5799
## [57] 1904.3541 1989.9070 1989.0625 1929.7877 1989.3102 1984.6708 1789.8745
## [64] 1878.0952 1931.2403 1460.6422 1910.3065 1968.7278 1952.5751 1986.2316
## [71] 1950.0376 1813.9288 1925.8955 1985.5169 1823.7115 1964.4287 1936.1150
## [78] 1916.5175 1974.1820 1901.1660 1815.3056 1537.9055 1985.9075 1988.0793
## [85] 1939.7137 1969.5128 896.9487 1706.0815 1206.1649a = melt(conv.rec(long_mif_output))## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.p = ggplot(data = melt(conv.rec(long_mif_output)),
aes(x = iteration, y = value, group = variable, color = factor(variable))) +
geom_line()+
guides(color=FALSE)+
facet_wrap(~variable, scales="free_y") + theme_bw()## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.p## Warning: Removed 2 row(s) containing missing values (geom_path).
mif_100_run_plot_file_name = paste0("../Figures/MIF_local_test_results/",
model_name,
"_test_mif_convergence_dem_stoch_plot_1_run_100_iterations_from_sim_data_truth.png")
png(mif_100_run_plot_file_name)
print(p)## Warning: Removed 2 row(s) containing missing values (geom_path).dev.off()## quartz_off_screen
## 2#Test pfilter likelihood at end of this simulation
mif_long_test_end_par = long_mif_output@params
registerDoRNG(123456)
ptm <- proc.time()
rds_index = rds_index + 1
pfilter_mif_sim_100_iteration_end_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = pfilter_mif_sim_100_iteration_end_rds_file_name,{
foreach(i=1:10, .packages = 'pomp',
.export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames",
"mif_long_test_end_par", "par_trans", "acumvarnames")
) %dopar% {
pfilter(data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = mif_long_test_end_par,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
tol = 0,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
format = "data.frame",
Np = 1000)
}
}) ->pfilter_sim_at_long_mif_end
proc.time() - ptm## user system elapsed
## 0.144 0.004 0.158(L_pfilter_sim_at_long_mif_end <- logmeanexp(sapply(pfilter_sim_at_long_mif_end, logLik), se = TRUE))## se
## -619.84317442 0.02631345L_pfilter_sim_at_long_mif_end## se
## -619.84317442 0.02631345Pfilter_LL_Mif_sim_100_runs_end_output_file_name = paste0("../Generated_Data/MIF_local_test_results/", model_name,
"_validation_pfilter_ranges_100_iteration_single_MIF_run.RData")
save(L_pfilter_sim_at_long_mif_end,
file = Pfilter_LL_Mif_sim_100_runs_end_output_file_name)
#-619.84317442 0.02631345
# This is not higher than the true sim mean of -619.86722850 (se 0.03028052 ), so did a longer run.2nd really long single MIF run
One mif run, 2000 particles, 200 iterations
ptm = proc.time()
rds_index = rds_index + 1
mif_sim_250_run_output_rds_file_name = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = mif_sim_250_run_output_rds_file_name,{
mif2(
data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
seed = 23456,
rprocess = pomp::euler(rproc,delta.t = 1),
params = param_vec,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
start = param_vec,
Np = 2000,
tol = 0,
Nmif = 250,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd(phi_E = 0,
phi_U = 0,
b_p = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
) }) -> long_mif_output_2
proc.time() - ptm## user system elapsed
## 0.023 0.002 0.027long_mif_output_2@eff.sample.size## [1] 2000.0000 2000.0000 903.2123 1635.2764 1655.4600 1888.8846 1544.4725
## [8] 1297.6706 1362.7517 1706.3701 1915.0708 1900.8018 1922.8668 1845.3120
## [15] 1957.3275 1995.6648 1982.8951 1992.6938 1993.6238 1989.2417 1992.3121
## [22] 1997.3582 1966.1209 1972.1221 1998.4096 1986.0719 1998.5476 1997.4465
## [29] 1998.4212 1998.4189 1993.9720 1998.8439 1998.0499 1998.8909 1998.7334
## [36] 1998.1000 1993.8721 1998.6951 1998.5048 1884.1809 1990.5605 1979.7095
## [43] 1995.0808 1928.3581 1988.1546 1956.2621 1953.2256 1917.3938 1973.3453
## [50] 1987.4763 1915.3035 1988.6766 1986.1561 1995.4079 1782.9761 1998.3963
## [57] 1968.8296 1998.4233 1997.8915 1976.2572 1997.9227 1995.9366 1932.8955
## [64] 1951.3567 1978.8841 1785.2685 1974.9520 1991.4445 1983.7625 1996.6899
## [71] 1982.0332 1925.5710 1972.2814 1996.0738 1925.8115 1985.2135 1978.4838
## [78] 1967.9673 1990.4197 1954.0441 1911.5480 1749.0781 1994.3521 1996.2218
## [85] 1957.3273 1995.3516 1367.7714 1825.2516 1499.7582a = melt(conv.rec(long_mif_output_2))## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.p = ggplot(data = melt(conv.rec(long_mif_output_2)),
aes(x = iteration, y = value, group = variable, color = factor(variable))) +
geom_line()+
guides(color=FALSE)+
facet_wrap(~variable, scales="free_y") + theme_bw()## Warning: 'conv.rec' is deprecated and will be removed in a forthcoming
## release. Please use 'traces' instead.p## Warning: Removed 2 row(s) containing missing values (geom_path).
MIF_sim_250_run_output_plot_file_name = paste0("../Figures/MIF_local_test_results/",
model_name, "_test_mif_convergence_dem_stoch_plot_1_run_200_iterations_from_sim_data_truth.png")
png(MIF_sim_250_run_output_plot_file_name)
print(p)## Warning: Removed 2 row(s) containing missing values (geom_path).dev.off()## quartz_off_screen
## 2#Test pfilter likelihood at end of this simulation
mif_long_test_end_par_2 = long_mif_output_2@params
registerDoRNG(234567)
ptm <- proc.time()
rds_index = rds_index + 1
pfilter_long_mif_sim_250_iterations_end_output_rds_file = paste0("Stew_Files/", model_name, "_", "rds_", rds_index, ".rds")
bake(file = pfilter_long_mif_sim_250_iterations_end_output_rds_file,{
foreach(i=1:10, .packages = 'pomp',
.export = c("rproc", "rmeas", "dmeas", "mif_sim_data", "init", "paramnames", "statenames", "obsnames", "covar",
"mif_long_test_end_par_2", "par_trans", "acumvarnames")
) %dopar% {
pfilter(data = mif_sim_data,
times = mif_sim_data$time,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = mif_long_test_end_par_2,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
tol = 0,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
format = "data.frame",
Np = 1000)
}
}) ->pfilter_sim_at_long_mif_end_2
proc.time() - ptm## user system elapsed
## 0.125 0.006 0.155(L_pfilter_sim_at_long_mif_end_2 <- logmeanexp(sapply(pfilter_sim_at_long_mif_end_2, logLik), se = TRUE))## se
## -618.83279774 0.01847462pfilter_long_mif_sim_250_iterations_end_LL_file_name = paste0("../Generated_Data/MIF_local_test_results/", model_name, "_validation_pfilter_ranges_200_iteration_single_MIF_run.RData")
save(L_pfilter_sim_at_long_mif_end_2,
file = pfilter_long_mif_sim_250_iterations_end_LL_file_name)
#-618.83279774 0.01847462
# This is higher than true sim mean of -619.86722850 (se 0.03028052), so it seems to have worked (at least, this is enough to move on to a grid search using Midway).MIF Run 1
Code to generate parameter grid for initial grid search
knitr::read_chunk('generate_param_grid_covid_NYC_N_12.R')# Header ------------------------------------------------------------------
## Name: generate_param_grid_covid_NYC_N_12.R
## Author: Rahul Subramanian
## Description: Creates 25,000 combination parameter grid via LHS for
## Model N_12
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
library(stringr)
args = commandArgs(trailingOnly=TRUE)
#model_name = "N_12"
model_name = as.character(args[1])
print(model_name)
require(tgp)
x <- lhs(25000,
rbind(
c(5,5), # M_0
c(13,13), # V_0
c(14,14), # K_0
c(2.0,8.0), # R_0
c(0,1), # b_q
c(0,1), # b_a
c(0,0), # b_p
c(0,1), # p_S
c(.05,.40), # p_H_cond_S
c(1.09,1.09), # phi_E
c(1.09,1.09), # phi_U
c(1/5,1/5), # phi_S
c(1/8,1/8), # h_V
c(1/1,1/5), # gamma
c(8.0e6,8.0e6), # N_0
c(0,2e4), #E_0
c(0,2e4), #z_0
c(0,0), #C_0
c(1.7e+01,1.7e+01), #social_distancing_start_time
c(2.2e+01, 2.2e+01), # quarantine_start_time
c(9.0e-01,9.0e-01), # PCR_sens
c(0,0.50), # sigma_M
c(1.215073e-02 ,1.215073e-02 ), # beta_w_3
c(9.810086e-01,9.810086e-01), # beta_w_2
c(-3.723481e+01,-3.723481e+01), # beta_w_1
c(2.294094e+02,2.294094e+02), # beta_w_0
c(1.183300e+03,1.183300e+03), # g_0
c(1.162005e-01,1.162005e-01), # g_F
c(1.091121e+02,1.091121e+02), # sigma_epsilon
c(1.62e-01,1.62e-01) # G_w_y_scaling
)
)
names <- c("M_0","V_0", "K_0","R_0","b_q","b_a","b_p","p_S","p_H_cond_S","phi_E",
"phi_U",
"phi_S","h_V","gamma","N_0","E_0","z_0","C_0",
"social_distancing_start_time","quarantine_start_time",
"PCR_sens","sigma_M", "beta_w_3", "beta_w_2",
"beta_w_1", "beta_w_0", "g_0", "g_F", "sigma_epsilon",
"G_w_y_scaling")
x <- as.data.frame(x)
colnames(x) <- names
write.csv(x, file = paste0("../Generated_Data/Profile_Combination_Lists/",
model_name,"_Model/",
model_name,
"_param_grid.csv"),
append = FALSE, row.names = FALSE)
proc.time() - ptmCode for first MIF run from grid search (SEIAR Model)
knitr::read_chunk('MIF_run_Model_N_12.R')# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
model_name = as.character(args[1])
print(model_name)
#model_name = "N_12"
#param_index = 1
#i = 1
#Load Observed NYC case data
Observed_data = read.csv(paste0(
"../Generated_Data/observed_data_",
model_name, ".csv"))
head(Observed_data)
### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")
## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14
#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")
## Load NYC covariate data
covariate_df = read.csv(file =
paste0("../Generated_Data/covariate_data_",
model_name, ".csv"))
### Create covariate table
covar=covariate_table(
time=covariate_df$times,
L_advanced_2_days=covariate_df$L_advanced_2_days,
F_w_y = covariate_df$F_w_y,
L_orig = covariate_df$L_orig,
w = covariate_df$Week,
y = covariate_df$Year,
times="time"
)
require(foreach)
require(doParallel)
require(deSolve)
#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
cl <- makeCluster(no_cores)
registerDoParallel(cl)
param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)
##load(param_grid)
pd = read.csv(
file = paste0(
"../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/",
model_name,
"_param_grid.csv"
),
header = TRUE
)
head(pd)
midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
seq_len(nrow(param_data_subset_act)),
each = Num_mif_runs_per_start),]
rw_sd_list_default = rw.sd(
M_0 = 0,
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_U = 0,
b_p = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
rw.sd = rw_sd_list_default
detail_log = FALSE
if (detail_log == TRUE) {
detailed_log_file_name = paste0(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
profile_var,
"_Profile/Detailed_Log/log_file_subset_",
param_index,
".txt"
)
write(file = detailed_log_file_name,
paste0("Log generated on ", Sys.time(), " \n"),
append = FALSE)
}
mif_single_subset_data <-
foreach(
i = 1:nrow(param_data_subset),
.combine = rbind,
.packages = c('pomp', 'dplyr'),
.export = c(
"rproc",
"rmeas",
"dmeas",
"init",
"paramnames",
"statenames",
"obsnames",
"param_data_subset",
"par_trans",
"acumvarnames",
"covar"
)
) %dopar%
{
tryCatch({
print(param_data_subset[i,])
print("iter_num")
print(i)
print("param_index")
print(param_index)
params = param_data_subset[i,]
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
seed <- round(runif(1, min = 1, max = 2 ^ 30))
#seed = 565013131
mif_single_param_output <- mif2(
data = Observed_data,
times = Observed_data$times,
t0 = t0,
seed = seed,
rproc = pomp::euler(rproc, delta.t = 1),
params = params,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
tol = 0,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
start = params,
Np = 10000,
Nmif = 50,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd
)
first_trace_df = mif_single_param_output@traces %>%
as.data.frame()
first_trace_df$trace_num = seq(1:nrow(first_trace_df))
# trace_df_ll = trace_df %>%
# dplyr::select(loglik, nfail)
# trace_df_no_ll = trace_df %>%
# dplyr::select(-loglik, -nfail)
# trace_df = trace_df_no_ll %>%
# mutate(nfail = trace_df_ll$nfail,
# loglik = trace_df_ll$loglik)
first_trace_df$loglik
first_trace_df$loglist.se = NA
first_trace_df$iter_num = i
first_trace_df$param_index = param_index
first_trace_df$msg = "first_trace"
mif_second_round = mif_single_param_output %>%
mif2(Nmif = 50)
second_trace_df = mif_second_round@traces %>%
as.data.frame()
second_trace_df$trace_num = seq(1:nrow(second_trace_df))
second_trace_df$loglik
second_trace_df$loglist.se = NA
second_trace_df$iter_num = i
second_trace_df$param_index = param_index
second_trace_df$msg = "second_trace"
ll <- tryCatch(
replicate(n = 10, logLik(
pfilter(
data = Observed_data,
times = Observed_data$times,
t0 = t0,
rprocess = pomp::euler(rproc, delta.t = 1),
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
format = "data.frame",
Np = 50000,
params = coef(mif_second_round)
)
)),
error = function(e)
e
)
fin = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
if (is(ll, "error")) {
} else{
ll_with_se = logmeanexp(ll, se = TRUE)
if (detail_log == TRUE) {
log_str = paste0(log_str,
"pfilter_warnings: \n ",
warnings(),
" \n Done with warnings \n")
}
}
if (is.na(ll_with_se[[1]])) {
} else{
fin$loglik = ll_with_se[[1]]
fin$loglist.se = ll_with_se[[2]]
}
fin$iter_num = i
fin$param_index = param_index
fin$msg = "mif1"
start_and_trace = bind_rows(start, first_trace_df)
start_and_trace = bind_rows(start_and_trace, second_trace_df)
bind_rows(start_and_trace, fin)
},
error = function (e) {
warning("Inside error function")
print("iter_num")
print(i)
print("param_index")
print(param_index)
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
start$loglik = NA
start$nfail = NA
start$trace_num = NA
start$loglist.se = NA
fin = start
fin$msg = conditionMessage(e)
full_join(start, fin, by = names(start))
})
} -> res
output_name = paste(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
"Grid_Search_MIF_run_1/",
model_name,
"_Grid_Search_MIF_run_1_subset_",
param_index,
".RData",
sep = ""
)
if (detail_log == TRUE) {
write(file = detailed_log_file_name, log_output, append = TRUE)
}
save(res, file = output_name)
res
proc.time() - ptmScript to execute code for first MIF run on Midway computing cluster
cat Midway_script_Model_N_12_Grid_Search_MIF_run_1_Profile.sbatch#!/bin/bash
#SBATCH --job-name=Grid_Search_MIF_run_1_N_12
#SBATCH --output=Grid_Search_MIF_run_1_N_12_%A_%a.out
#SBATCH --error=error_Grid_Search_MIF_run_1_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=28
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000
echo $SLURM_ARRAY_TASK_ID
module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args N_12' MIF_run_Model_N_12.R OUT_Grid_Search_MIF_run_1/out.$SLURM_ARRAY_TASK_ID Analyze MIF Run 1
Combine output
Combine Midway output susbsets
Once all of the 500 array jobs submitted to Midway have finished running on the cluster, the output from each of those 500 jobs is combined into one data frame with combinations and likelihoods for the initial grid search.
Code for combining
# ---- combine_grid_search_output ----
# Header ------------------------------------------------------------------
## Name: combine_grid_search_output
## Author: Rahul Subramanian
## Description: Combine MIF real grid search output data into one big data frame
combine_grid_search_output = function(model_name){
ptm = proc.time()
#args = commandArgs(trailingOnly=TRUE)
###Load parameter list
pd = read.csv(
file = paste0(
"../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/",
model_name,
"_param_grid.csv"
),
header = TRUE
)
mif_sim_combined_output_df = data.frame(
matrix(nrow = 0, ncol = ncol(pd) + 7)
)
colnames(mif_sim_combined_output_df) = c(colnames(pd), "LL")
colnames(mif_sim_combined_output_df) = c(colnames(pd),"msg", "iter_num", "param_index", "loglik", "nfail", "trace_num", "loglist.se")
midway_max_jobs = 500
jobs_done_so_far = 500
mif_sim_combined_output_with_traces_df = mif_sim_combined_output_df
for(param_index in seq(1:jobs_done_so_far)){
if(param_index %% 10 == 0){
#print(param_index)
}
input_file_name = paste("../Generated_Data/Profiles/",
model_name,
"_Model/",
"Grid_Search_MIF_run_1/",
model_name,
"_Grid_Search_MIF_run_1_subset_",
param_index,
".RData",
sep = ""
)
if(file.exists(input_file_name) == TRUE){
load(file = input_file_name)
mif_output_df_single_subset = res
}else{
group_size = nrow(pd)/midway_max_jobs
start_index = (param_index-1)*group_size + 1
end_index = param_index*group_size
Num_mif_runs_per_start = 10
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(seq_len(nrow(param_data_subset_act)), each = Num_mif_runs_per_start),]
#param_data_subset$seed = NA;
param_data_subset$msg = NA
param_data_subset$iter_num = NA
param_data_subset$param_index = NA
param_data_subset$nfail = NA
param_data_subset$trace_num = NA
param_data_subset$loglik = NA
param_data_subset$loglist.se = NA
mif_output_df_single_subset = param_data_subset
}
#head(mif_output_df_single_subset)
local_MLE = max(mif_output_df_single_subset$loglik, na.rm = TRUE)
subset_traces = mif_output_df_single_subset %>%
filter(iter_num == 3)
subset_data_no_traces =mif_output_df_single_subset %>%
filter(msg != "first_trace") %>%
filter(msg != "second_trace")
mif_sim_combined_output_with_traces_df =
rbind(mif_sim_combined_output_with_traces_df,subset_traces)
mif_sim_combined_output_df = rbind(mif_sim_combined_output_df, subset_data_no_traces)
}
output_file_name = paste0("../Generated_Data/Profiles/", model_name,"_Model/","Grid_Search_MIF_run_1/",
model_name, "_Grid_Search_MIF_run_1_combined_data_subset_including_traces_and_start.RData")
save(mif_sim_combined_output_with_traces_df, file = output_file_name)
output_file_name = paste0("../Generated_Data/Profiles/", model_name,"_Model/","Grid_Search_MIF_run_1/",
model_name, "_Grid_Search_MIF_run_1_combined_data.RData")
save(mif_sim_combined_output_df, file = output_file_name)
output_list = list(mif_sim_combined_output_df, mif_sim_combined_output_with_traces_df)
return(output_list)
}
combine_grid_search_output(model_name = model_name)Analyze output
library(GGally)##
## Attaching package: 'GGally'## The following object is masked from 'package:dplyr':
##
## nasashared_params_plot1 = function(data, ..., ll= TRUE){
if(missing(..1)){
ae = aes(color=msg)
} else{
ae = aes(...)
}
cols = c("E_0", "z_0","R_0", "p_S", "p_H_cond_S","gamma", "b_a",
"b_q", "b_p","sigma_M")
collabs = c("E_0", "z_0","R_0", "p_S", "p_H_cond_S", "gamma", "b_a",
"b_q","b_p", "sigma_M")
if(ll) {
cols = c(cols, "loglik")
collabs = c(collabs, "log(L)")
}
data %>%
ggpairs(mapping = ae, upper = NULL, legend = 1,
lower = list(continuous=wrap("points", alpha = 0.5, size = 0.2)),
diag = list(continuous = wrap("densityDiag", alpha = 0.5)),
columns = cols, columLabels = collabs, labeller = "label_parsed") +
theme(legend.position = "bottom", axis.text.x=element_text(angle = -90))
}Plot shared parameters
load(file = paste0("../Generated_Data/Profiles/",
model_name,"_Model/","Grid_Search_MIF_run_1/",
model_name,
"_Grid_Search_MIF_run_1_combined_data_subset_including_traces_and_start.RData"))
head(mif_sim_combined_output_with_traces_df)## M_0 V_0 K_0 R_0 b_q b_a b_p p_S p_H_cond_S phi_E
## 1 5 13 14 2.412468 0.4416637 0.5396230 0 0.8046790 0.2628008 1.09
## 2 5 13 14 2.412468 0.4416637 0.5396230 0 0.8046790 0.2628008 1.09
## 3 5 13 14 2.560549 0.3413616 0.4824313 0 0.8237105 0.2407564 1.09
## 4 5 13 14 2.754835 0.2089228 0.5218541 0 0.7827363 0.2020443 1.09
## 5 5 13 14 3.418725 0.1687828 0.5131164 0 0.7901393 0.2119792 1.09
## 6 5 13 14 4.024363 0.1401924 0.5160041 0 0.8126989 0.1420537 1.09
## phi_U phi_S h_V gamma N_0 E_0 z_0 C_0
## 1 1.09 0.2 0.125 0.4660418 8e+06 9589.921 4768.716 0
## 2 1.09 0.2 0.125 0.4660418 8e+06 9589.921 4768.716 0
## 3 1.09 0.2 0.125 0.5127500 8e+06 9312.537 4726.688 0
## 4 1.09 0.2 0.125 0.6098783 8e+06 9237.455 4791.424 0
## 5 1.09 0.2 0.125 0.7906985 8e+06 9365.036 4807.121 0
## 6 1.09 0.2 0.125 0.7640009 8e+06 9280.389 4803.246 0
## social_distancing_start_time quarantine_start_time PCR_sens sigma_M
## 1 17 22 0.9 0.1170890
## 2 17 22 0.9 0.1170890
## 3 17 22 0.9 0.5046780
## 4 17 22 0.9 0.3739315
## 5 17 22 0.9 0.3033004
## 6 17 22 0.9 0.2871302
## beta_w_3 beta_w_2 beta_w_1 beta_w_0 g_0 g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## G_w_y_scaling msg iter_num param_index loglik nfail trace_num
## 1 0.162 start 3 1 NA NA NA
## 2 0.162 first_trace 3 1 -869.0832 0 1
## 3 0.162 first_trace 3 1 -669.0413 0 2
## 4 0.162 first_trace 3 1 -649.4983 0 3
## 5 0.162 first_trace 3 1 -643.1247 0 4
## 6 0.162 first_trace 3 1 -638.5519 0 5
## loglist.se
## 1 NA
## 2 NA
## 3 NA
## 4 NA
## 5 NA
## 6 NAload(file = paste0("../Generated_Data/Profiles/", model_name,"_Model/","Grid_Search_MIF_run_1/",
model_name, "_Grid_Search_MIF_run_1_combined_data.RData"))
head(mif_sim_combined_output_df)## M_0 V_0 K_0 R_0 b_q b_a b_p p_S p_H_cond_S
## 1 5 13 14 5.883121 0.93214007 0.5123999 0 0.1359062 0.3735517
## 2 5 13 14 25.679210 0.04331488 0.4653650 0 0.1497828 0.6199107
## 3 5 13 14 4.990241 0.49076665 0.4625613 0 0.3424364 0.2245220
## 4 5 13 14 5.040920 0.11998162 0.7382745 0 0.3773241 0.1767405
## 5 5 13 14 2.412468 0.44166372 0.5396230 0 0.8046790 0.2628008
## 6 5 13 14 4.662393 0.12059422 0.6883708 0 0.5929974 0.1551997
## phi_E phi_U phi_S h_V gamma N_0 E_0 z_0 C_0
## 1 1.09 1.09 0.2 0.125 0.4608219 8e+06 5030.176 3712.279 0
## 2 1.09 1.09 0.2 0.125 2.9115623 8e+06 7142.424 5077.334 0
## 3 1.09 1.09 0.2 0.125 0.5335474 8e+06 13629.668 6149.248 0
## 4 1.09 1.09 0.2 0.125 17.3948547 8e+06 22528.896 4862.690 0
## 5 1.09 1.09 0.2 0.125 0.4660418 8e+06 9589.921 4768.716 0
## 6 1.09 1.09 0.2 0.125 4.8184949 8e+06 14264.687 3496.775 0
## social_distancing_start_time quarantine_start_time PCR_sens sigma_M
## 1 17 22 0.9 0.09867105
## 2 17 22 0.9 0.30525948
## 3 17 22 0.9 0.48712651
## 4 17 22 0.9 0.28146121
## 5 17 22 0.9 0.11708904
## 6 17 22 0.9 0.28128330
## beta_w_3 beta_w_2 beta_w_1 beta_w_0 g_0 g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## G_w_y_scaling msg iter_num param_index loglik nfail trace_num
## 1 0.162 start 1 1 NA NA NA
## 2 0.162 mif1 1 1 -645.8693 NA NA
## 3 0.162 start 2 1 NA NA NA
## 4 0.162 mif1 2 1 -629.8487 NA NA
## 5 0.162 start 3 1 NA NA NA
## 6 0.162 mif1 3 1 -629.9411 NA NA
## loglist.se
## 1 NA
## 2 0.012978255
## 3 NA
## 4 0.007197377
## 5 NA
## 6 0.005469438top_2_LL_params = mif_sim_combined_output_df %>%
mutate(loglik = loglik-max(loglik, na.rm = TRUE)) %>%
filter(is.na(loglik) | loglik>-2)
top_2_LL_params = top_2_LL_params %>%
filter(msg == "mif1" || msg == "start")
mif_1_result_plot = top_2_LL_params%>%
shared_params_plot1()## Warning in warn_if_args_exist(list(...)): Extra arguments: 'columLabels'
## are being ignored. If these are meant to be aesthetics, submit them
## using the 'mapping' variable within ggpairs with ggplot2::aes or
## ggplot2::aes_string.png("../Figures/Profiles/N_12_Model/MIF_Run_1/MIF_Run_1_Histogram_Result_Plot.png")
print(mif_1_result_plot)## Warning: Removed 25000 rows containing missing values (geom_point).## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing missing values (geom_point).
## Warning: Removed 25000 rows containing missing values (geom_point).## Warning: Removed 25000 rows containing non-finite values (stat_density).dev.off()## quartz_off_screen
## 2Analyze R_0 values
top_2_LL_end_params = top_2_LL_params %>%
filter(msg == "mif1")
#top_2_LL_end_params$R_0
min(mif_sim_combined_output_df$R_0)## [1] 0.1935601mif_sim_combined_output_df_end_params = filter(mif_sim_combined_output_df) %>%
filter(msg == "mif1")
min(mif_sim_combined_output_df_end_params$R_0)## [1] 0.1935601range(top_2_LL_end_params$R_0)## [1] 3.057067 21.830078hist(top_2_LL_end_params$R_0)
p = ggplot(data = top_2_LL_end_params,
aes(x = R_0, y = loglik)) +
geom_point() +
rahul_man_figure_theme
p
p = ggplot(data = top_2_LL_end_params,
aes(x = E_0, y = loglik)) +
geom_point() +
rahul_man_figure_theme
p
p = ggplot(data = top_2_LL_end_params,
aes(x = E_0+z_0, y = loglik)) +
geom_point() +
rahul_man_figure_theme
p
p = ggplot(data = top_2_LL_end_params,
aes(x = R_0, y = E_0+z_0)) +
geom_point() +
rahul_man_figure_theme
p
p = ggplot(data = top_2_LL_end_params,
aes(x = R_0, y = p_S)) +
geom_point() +
rahul_man_figure_theme
p
range(top_2_LL_end_params$sigma_M)## [1] 0.2746054 0.2894537top_20_LL_end_params = mif_sim_combined_output_df_end_params %>%
filter(loglik > max(loglik)-20)Evalulate model performance
Antibody data
Antibody data from Table 2 of
https://www.medrxiv.org/content/10.1101/2020.06.28.20142190v1.full.pdf
(Version posted on June 29, 2020, accessed on July 4,2020).
nyc_sentinel_antibody_obs = data.frame(Date = c("2020-03-01",
"2020-03-08",
"2020-03-15",
"2020-03-22",
"2020-03-29",
"2020-04-05",
"2020-04-12",
"2020-04-19"),
Num_Positive = c(8,
2,
8,
7,
9,
33,
27,
47),
Prop_Positive = c(0.020,
0.005,
0.016,
0.017,
0.022,
0.101,
0.117,
0.193),
Num_Sampled = c(402,
407,
493,
425,
412,
326,
230,
243))
nyc_sentinel_antibody_obs = nyc_sentinel_antibody_obs %>%
mutate(Date = as.Date(Date))
write.csv(nyc_sentinel_antibody_obs,
"../Generated_Data/raw_antibody_data_from_nyc_study.csv",
row.names = FALSE)
p = ggplot(data = nyc_sentinel_antibody_obs,
aes(x = Date, y = Prop_Positive)) + geom_point() +
geom_line() + rahul_man_figure_theme
p
png("../Figures/Profiles/N_12_Model/Anitbody_data.png")
print(p)
dev.off()## quartz_off_screen
## 2We followed the Wilson-Brown CI method as described here: https://www.itl.nist.gov/div898/handbook/prc/section2/prc241.htm
#Ex:
#p = 0.1
#n = 10
#alpha = 0.05
get_Wilson_Brown_upper_CI = function(p, n, alpha){
Z_score_upper = qnorm(p = 1-alpha/2, mean = 0, sd = 1)
Z_score_upper_sq = Z_score_upper^2
upper_under_sqrt = ((p*(1-p))/n) + Z_score_upper_sq/(4*n^2)
UL_num = p + ((Z_score_upper_sq)/(2*n)) + Z_score_upper*sqrt(upper_under_sqrt)
UL_denom = 1 + Z_score_upper_sq/n
UL_bound = UL_num/UL_denom
return(UL_bound)
}
get_Wilson_Brown_lower_CI = function(p, n, alpha){
Z_score_lower = qnorm(p = alpha/2, mean = 0, sd = 1)
Z_score_lower_sq = Z_score_lower^2
lower_under_sqrt = ((p*(1-p))/n) + Z_score_lower_sq/(4*n^2)
LL_num = p + ((Z_score_lower_sq)/(2*n)) + Z_score_lower*sqrt(lower_under_sqrt)
LL_denom = 1 + Z_score_lower_sq/n
LL_bound = LL_num/LL_denom
return(LL_bound)
}nyc_antibody_df = nyc_sentinel_antibody_obs %>%
mutate(times = as.numeric(Date - true_start_date),
upper_CI = get_Wilson_Brown_upper_CI(n = Num_Sampled, p = Prop_Positive, alpha = 0.05),
lower_CI = get_Wilson_Brown_lower_CI(n = Num_Sampled, p = Prop_Positive, alpha = 0.05))
write.csv(nyc_antibody_df,
"../Generated_Data/antibody_data_from_nyc_study_with_RS_calc_CI.csv",
row.names = FALSE)
p = ggplot(data = nyc_antibody_df,
aes(x = Date, y = Prop_Positive)) + geom_ribbon(aes(ymin = lower_CI,
ymax = upper_CI),
fill = 'grey70',
alpha = 0.7) +
geom_point() +
geom_line() + rahul_man_figure_theme
p
png("../Figures/Profiles/N_12_Model/Anitbody_data_with_RS_calc_CI_dates.png")
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive)) + geom_ribbon(aes(ymin = lower_CI,
ymax = upper_CI),
fill = 'grey70',
alpha = 0.7) +
geom_point() +
geom_line() + rahul_man_figure_theme + xlab("Days since March 1, 2020")
p
png("../Figures/Profiles/N_12_Model/Anitbody_data_with_RS_calc_CI_days.png")
print(p)
dev.off()## quartz_off_screen
## 2###Load ML combination for model
MLE = mif_sim_combined_output_df %>%
filter(msg == "mif1") %>%
filter(loglik == max(loglik))
ML_params = MLE %>%
dplyr::select(-param_index, -iter_num,
-msg, -loglik, -nfail,
-trace_num, -loglist.se)
MIF_run_1_MLE_params = ML_params
MIF_run_1_MLE_params## M_0 V_0 K_0 R_0 b_q b_a b_p p_S p_H_cond_S phi_E
## 1 5 13 14 4.426536 0.1212218 0.9829669 0 0.2869619 0.1939382 1.09
## phi_U phi_S h_V gamma N_0 E_0 z_0 C_0
## 1 1.09 0.2 0.125 9.638642 8e+06 30583.41 5323.79 0
## social_distancing_start_time quarantine_start_time PCR_sens sigma_M
## 1 17 22 0.9 0.279458
## beta_w_3 beta_w_2 beta_w_1 beta_w_0 g_0 g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## G_w_y_scaling
## 1 0.162write.csv(MLE, file = "../Generated_Data/Profiles/N_12_Model/Grid_Search_MIF_run_1/MLE_Grid_Search_MIF_run_1_with_LL.csv",
row.names = FALSE)
write.csv(MIF_run_1_MLE_params, file = "../Generated_Data/Profiles/N_12_Model/Grid_Search_MIF_run_1/MLE_Grid_Search_MIF_run_1.csv",
row.names = FALSE)Simulate trajectories from MLE parameters for baseline model
We simulate 100 stochastic trajectories (both process and environmental noise) from the overall MLE for the baseline model. We calculate the mean and the 2.5\(\%\) and 97.5\(\%\) quantile for values of the trajectories.
##Simulation from ML
sim_data = simulate(nsim = 100,
seed = 12345,
times = Observed_data$times,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = ML_params,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
format = "data.frame")
#head(sim_data)
sim_data_median_Y = aggregate(Y ~ time, sim_data, median)
sim_data_quant = aggregate(Y ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_quant$Y = as.data.frame(sim_data_quant$Y)
colnames(sim_data_quant$Y) = c("Q2.5", "Q97.5")Compare simulated trajectories with that of real data
The plots below show the real observed dengue case trajectory versus the mean and 2.5\(\%\) and 97.5\(\%\) quantile from the stochastic simulation of the baseline model maximum likelihood estimate.
comp_data = data.frame(time = sim_data_median_Y$time,
sim_data_median = sim_data_median_Y$Y,
sim_data_low_Q = sim_data_quant$Y$Q2.5,
sim_data_high_Q = sim_data_quant$Y$Q97.5,
true_data = Observed_data$Y)
comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
"sim_data_high_Q"))
p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
ymax = sim_data_high_Q), fill = "grey70") +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable), size = 3) +
rahul_theme +
theme_white_background +
median_legend_lab + rahul_man_figure_theme +
xlab("Days since March 1, 2020")+
ylab("Observed Daily Cases")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/MIF_Run_1/cases_over_time_simulation_from_ML_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = log(sim_data_low_Q),
ymax = log(sim_data_high_Q)), fill = "grey70") +
geom_line(aes(x = time, y = log(value), color = variable)) +
geom_point(aes(x = time, y = log(value), color = variable)) +
rahul_theme +
theme_white_background +
median_legend_lab_with_fit_data + rahul_man_figure_theme +
xlab("Days since March 1, 2020")+
ylab("log(Observed Daily Cases)")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/MIF_Run_1/log_cases_over_time_simulation_from_ML_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = log(sim_data_low_Q),
ymax = log(sim_data_high_Q)), fill = "grey70") +
geom_line(aes(x = time, y = log(value), color = variable)) +
geom_point(aes(x = time, y = log(value), color = variable)) +
rahul_theme +
theme_white_background +
median_legend_lab_with_fit_data +rahul_man_figure_theme+
xlab("Days since March 1, 2020")+
ylab("log(Daily Reported Cases)")
p
S over N
sim_data$S_over_N = sim_data$S/sim_data$N
sim_data_S_over_N_median = aggregate(S_over_N ~ time, sim_data, median)
sim_data_S_over_N_quant = aggregate(S_over_N ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_S_over_N_quant$S_over_N = as.data.frame(sim_data_S_over_N_quant$S_over_N)
colnames(sim_data_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")
comp_data = data.frame(time = sim_data_S_over_N_median$time,
sim_data_median = sim_data_S_over_N_median$S_over_N,
sim_data_low_Q = sim_data_S_over_N_quant$S_over_N$Q2.5,
sim_data_high_Q = sim_data_S_over_N_quant$S_over_N$Q97.5)
comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
"sim_data_high_Q"))
p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
ymax = sim_data_high_Q), fill = "grey70") +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable), size = 3) +
rahul_theme +
theme_white_background +
median_legend_lab + rahul_man_figure_theme +
xlab("Days since March 1, 2020")+
ylab("S over N")
p
png("../Figures/Profiles/N_12_Model/MLE_S_over_N.png")
print(p)
dev.off()## quartz_off_screen
## 2Specific trajectories (S/N MLE parameter combination)
select_trajectories = filter(sim_data, .id %in% seq(from = 5, to = 10))
select_trajectories = dplyr::select(select_trajectories, time, .id, S, N)
select_trajectories = select_trajectories %>%
mutate(S_over_N = S/N)
select_trajectories = select_trajectories %>%
dplyr::select(-S, -N)
select_trajectories$type = "Sim"
library(RColorBrewer)
full_blue_pallete = brewer.pal(9, "Blues")
sim_traj_pallete = full_blue_pallete[9:4]
sim_traj_scale = scale_color_manual(name = "Legend", values = c( sim_traj_pallete), labels = c("Sim_Traj_1", "Sim_Traj_2", "Sim_Traj_3", "Sim_Traj_4", "Sim_Traj_5", "Sim_Traj_6"))
p = ggplot(data = select_trajectories,
aes(x = time, y = S_over_N, color = .id)) + geom_point(size = 2) + geom_line(aes(group = .id)) + rahul_theme + rahul_man_figure_theme + theme_white_background +
sim_traj_scale
p
png("../Figures/Profiles/N_12_Model/MIF_Run_1/Specific_traj_S_over_N_MLE.png")
print(p)
dev.off()## quartz_off_screen
## 2R over N (MLE parameter combination)
sim_data$R_over_N = (sim_data$R_A +sim_data$R_F + sim_data$R_H)/sim_data$N
sim_data_R_over_N_median = aggregate(R_over_N ~ time, sim_data, median)
sim_data_R_over_N_quant = aggregate(R_over_N ~ time, sim_data, quantile, probs = c(0.025, 0.975))
sim_data_R_over_N_quant$R_over_N = as.data.frame(sim_data_R_over_N_quant$R_over_N)
colnames(sim_data_R_over_N_quant$R_over_N) = c("Q2.5", "Q97.5")
comp_data = data.frame(time = sim_data_R_over_N_median$time,
sim_data_median = sim_data_R_over_N_median$R_over_N,
sim_data_low_Q = sim_data_R_over_N_quant$R_over_N$Q2.5,
sim_data_high_Q = sim_data_R_over_N_quant$R_over_N$Q97.5)
comp_data_melt = melt(comp_data, id.vars = c("time", "sim_data_low_Q",
"sim_data_high_Q"))
p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = sim_data_low_Q,
ymax = sim_data_high_Q), fill = "grey70") +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable), size = 3) +
rahul_theme +
theme_white_background +
median_legend_lab + rahul_man_figure_theme +
xlab("Days since March 1, 2020")+
ylab("R over N")
p
png("../Figures/Profiles/N_12_Model/MLE_param_R_over_N.png")
print(p)
dev.off()## quartz_off_screen
## 2Specific trajectories (R/N MLE combination)
select_trajectories = filter(sim_data, .id %in% seq(from = 5, to = 10))
select_trajectories = dplyr::select(select_trajectories, time, .id, R_A,R_F, R_H, N)
select_trajectories = select_trajectories %>%
mutate(R_over_N = (R_A + R_H + R_F)/N)
select_trajectories = select_trajectories %>%
dplyr::select(-R_A, -R_H, -R_F, -N)
select_trajectories$type = "Sim"
library(RColorBrewer)
full_blue_pallete = brewer.pal(9, "Blues")
sim_traj_pallete = full_blue_pallete[9:4]
sim_traj_scale = scale_color_manual(name = "Legend", values = c( sim_traj_pallete), labels = c("Sim_Traj_1", "Sim_Traj_2", "Sim_Traj_3", "Sim_Traj_4", "Sim_Traj_5", "Sim_Traj_6"))
p = ggplot(data = select_trajectories,
aes(x = time, y = R_over_N, color = .id)) + geom_point(size = 2) + geom_line(aes(group = .id)) + rahul_theme + rahul_man_figure_theme + theme_white_background +
sim_traj_scale
p
png("../Figures/Profiles/N_12_Model/MIF_Run_1/Specific_traj_R_over_N_MLE_comb.png")
print(p)
dev.off()## quartz_off_screen
## 2Compare R/N with anitbody data (MLE parameter combination)
p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = sim_data_low_Q,
ymax = sim_data_high_Q), fill = "grey70") +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable), size = 3) +
rahul_theme +
theme_white_background +
median_legend_lab + rahul_man_figure_theme +
xlab("Days since March 1, 2020")+
ylab("R over N") +
geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
ymax = upper_CI),
fill = 'grey70',
alpha = 0.7) +
geom_point(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue') +
geom_line(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue')
p
png("../Figures/Profiles/N_12_Model/MLE_param_R_over_N_vs_anitbody_test.png")
print(p)
dev.off()## quartz_off_screen
## 2Top 2LL Simluation
Combine output subsets
top_2_LL_end_with_antibody_LL =
data.frame(matrix(nrow = 0,
ncol = ncol(top_2_LL_end_params) + 3))
colnames(top_2_LL_end_with_antibody_LL) =
c(colnames(top_2_LL_end_params), "Antibody_Mean_LL", "Antibody_LL_SE","Median_Herd_Immunity")
top_2_LL_all_combo_data = data.frame(matrix(nrow = 0, ncol = 5))
colnames(top_2_LL_all_combo_data) = c("time", "sim_data_median ", "sim_data_low_Q",
"sim_data_high_Q","combo_num")
top_2_LL_all_combo_S_data = data.frame(matrix(nrow = 0, ncol = 5))
colnames(top_2_LL_all_combo_S_data) = c("time", "sim_data_S_over_N_median ", "sim_data_S_over_N_low_Q",
"sim_data_S_over_N_high_Q","combo_num")
top_2_LL_all_combo_C_Q1_data = data.frame(matrix(nrow = 0, ncol = 5))
colnames(top_2_LL_all_combo_C_Q1_data) = c("time", "sim_data_C_Q1_median ", "sim_data_C_Q1_low_Q",
"sim_data_C_Q1_high_Q","combo_num")
top_2_LL_all_combo_R_data = data.frame(matrix(nrow = 0, ncol = 5))
colnames(top_2_LL_all_combo_R_data) = c("time", "sim_data_R_over_N_median ", "sim_data_R_over_N_low_Q",
"sim_data_R_over_N_high_Q","combo_num")
midway_max_jobs = 500
group_size = nrow(top_2_LL_end_params) / midway_max_jobs
for(param_index in seq(1:midway_max_jobs)){
if(param_index %% 50 == 0){
print(param_index)
}
load(file = paste0("../Generated_Data/Profiles/",
model_name, "_Model/Antibody_LL_Param_Subsets/",
model_name, "_Model_top_2_LL_all_params_top_2_LL_subset_",
param_index, ".RData"))
top_2_LL_end_with_antibody_LL = rbind(top_2_LL_end_with_antibody_LL,
top_2_LL_end_subset_with_antibody_LL)
load(
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/C_Q1_Subsets/",model_name,
"_Model_top_2_LL_all_params_top_2_LL_subset_",
param_index, ".RData"))
top_2_LL_all_combo_C_Q1_data = rbind(top_2_LL_all_combo_C_Q1_data,
all_combo_C_Q1_data)
load(file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/R_over_N_Subsets/",
model_name, "_Model_top_2_LL_all_params_sim_R_over_N_data_subset_",
param_index, ".RData"
))
top_2_LL_all_combo_R_data = rbind(top_2_LL_all_combo_R_data,
all_combo_R_data)
load(file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/S_over_N_Subsets/",
model_name, "_Model_top_2_LL_all_params_sim_S_over_N_data_subset_",
param_index, ".RData"
))
top_2_LL_all_combo_S_data = rbind(top_2_LL_all_combo_S_data,
all_combo_S_data)
load(file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/combo_data_Subsets/",model_name,
"_Model_top_2_LL_all_params_sim_cases_data_subset_",
param_index, ".RData"))
top_2_LL_all_combo_data = rbind(top_2_LL_all_combo_data,
all_combo_data)
}## [1] 50
## [1] 100
## [1] 150
## [1] 200
## [1] 250
## [1] 300
## [1] 350
## [1] 400
## [1] 450
## [1] 500save(top_2_LL_all_combo_data,file = paste0("../Generated_Data/Profiles/",
model_name, "_Model/top_2_LL_data/",model_name,
"_Model_top_2_LL_all_params_sim_cases_data.RData"))
save(top_2_LL_all_combo_S_data,file = paste0("../Generated_Data/Profiles/",
model_name, "_Model/top_2_LL_data/",model_name,
"_Model_top_2_LL_all_params_sim_S_over_N_data.RData"))
save(top_2_LL_all_combo_R_data,file = paste0("../Generated_Data/Profiles/",
model_name, "_Model/top_2_LL_data/",model_name,
"_Model_top_2_LL_all_params_sim_R_over_N_data.RData"))
save(top_2_LL_all_combo_C_Q1_data,file = paste0("../Generated_Data/Profiles/",
model_name, "_Model/top_2_LL_data/",model_name,
"_Model_top_2_LL_all_params_sim_C_Q_1_data.RData"))
save(top_2_LL_end_with_antibody_LL,file = paste0("../Generated_Data/Profiles/",
model_name, "_Model/top_2_LL_data/",model_name,
"_Model_top_2_LL_all_params_with_antibody_LL.RData"))Calculate R_0 NGM for top_2_LL
\[\begin{equation} R_{0_{NGM}} = \frac{\beta_P}{\phi_U} + \frac{\beta_A (1-p_S)}{\phi_S} + \frac{\beta p_S}{\phi_S} + \frac{\beta (1-p_{\text{H_cond_S}}) p_S}{\gamma} \end{equation}\]
In terms of model parameters: \[\begin{equation} R_{0_{NGM}} = \frac{\beta*b_p}{\phi_U} + \frac{\beta*b_a (1-p_S)}{\phi_S} + \frac{\beta p_S}{\phi_S} + \frac{\beta (1-p_{\text{H_cond_S}}) p_S}{\gamma} \end{equation}\]
head(top_2_LL_end_with_antibody_LL)## M_0 V_0 K_0 R_0 b_q b_a b_p p_S p_H_cond_S phi_E
## 1 5 13 14 5.040920 0.1199816 0.73827447 0 0.3773241 0.1767405 1.09
## 2 5 13 14 4.662393 0.1205942 0.68837081 0 0.5929974 0.1551997 1.09
## 3 5 13 14 5.579049 0.1183684 0.54631179 0 0.4603340 0.1669007 1.09
## 4 5 13 14 7.162057 0.1212649 0.44841826 0 0.2924341 0.1561453 1.09
## 5 5 13 14 7.141834 0.1235621 0.01397251 0 0.5145169 0.1537657 1.09
## 6 5 13 14 4.833856 0.1175417 0.95746195 0 0.2454977 0.1556645 1.09
## phi_U phi_S h_V gamma N_0 E_0 z_0 C_0
## 1 1.09 0.2 0.125 17.394855 8e+06 22528.90 4862.690 0
## 2 1.09 0.2 0.125 4.818495 8e+06 14264.69 3496.775 0
## 3 1.09 0.2 0.125 4.596704 8e+06 18134.69 4332.758 0
## 4 1.09 0.2 0.125 4.536257 8e+06 24722.19 7827.191 0
## 5 1.09 0.2 0.125 9.421572 8e+06 17913.11 3936.113 0
## 6 1.09 0.2 0.125 5.409624 8e+06 25495.10 9904.451 0
## social_distancing_start_time quarantine_start_time PCR_sens sigma_M
## 1 17 22 0.9 0.2814612
## 2 17 22 0.9 0.2812833
## 3 17 22 0.9 0.2813773
## 4 17 22 0.9 0.2816628
## 5 17 22 0.9 0.2831911
## 6 17 22 0.9 0.2842662
## beta_w_3 beta_w_2 beta_w_1 beta_w_0 g_0 g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## G_w_y_scaling msg iter_num param_index loglik nfail trace_num
## 1 0.162 mif1 2 1 -0.7954440 NA NA
## 2 0.162 mif1 3 1 -0.8877775 NA NA
## 3 0.162 mif1 4 1 -0.6177721 NA NA
## 4 0.162 mif1 9 1 -0.9084578 NA NA
## 5 0.162 mif1 11 1 -0.7863457 NA NA
## 6 0.162 mif1 15 1 -1.1438794 NA NA
## loglist.se Antibody_Mean_LL Antibody_LL_SE Median_Herd_Immunity
## 1 0.007197377 -69.35197 0.03117124 0.08318750
## 2 0.005469438 -114.25269 0.06406994 0.05208694
## 3 0.008664239 -88.04981 0.04744650 0.06717275
## 4 0.009767994 -51.50620 0.02663235 0.10390925
## 5 0.008395310 -100.56133 0.06835040 0.05824056
## 6 0.008197142 -39.44024 0.01943998 0.12597463
## combo_num sim_subset_index
## 1 1 1
## 2 2 1
## 3 3 1
## 4 4 1
## 5 5 1
## 6 6 1top_2_LL_end_with_antibody_LL$duration_of_symp_1 = 1/top_2_LL_end_with_antibody_LL$phi_S
top_2_LL_end_with_antibody_LL$duration_of_symp_2 = 1/top_2_LL_end_with_antibody_LL$gamma
top_2_LL_end_with_antibody_LL = top_2_LL_end_with_antibody_LL %>%
mutate(duration_of_symp = duration_of_symp_1 + duration_of_symp_2)
top_2_LL_end_with_antibody_LL$gamma_total = 1/top_2_LL_end_with_antibody_LL$duration_of_symp
top_2_LL_end_with_antibody_LL = top_2_LL_end_with_antibody_LL %>%
mutate(Beta = R_0*gamma_total)
top_2_LL_end_with_antibody_LL = top_2_LL_end_with_antibody_LL%>%
mutate(R_0_P = (Beta*b_p)/phi_U,
R_0_A = (Beta*b_a *(1-p_S))/phi_S,
R_0_S_1 = (Beta*p_S)/phi_S,
R_0_S_2 = (Beta*(1-p_H_cond_S)*p_S)/gamma)
top_2_LL_end_with_antibody_LL = top_2_LL_end_with_antibody_LL %>%
mutate(R_0_NGM = R_0_P + R_0_A + R_0_S_1 + R_0_S_2)
p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = R_0_NGM)) +
geom_density() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
"_density_plot_of_R_0_NGM_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = R_0_NGM)) +
geom_histogram() +
rahul_man_figure_theme
p## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
"_histogram_of_R_0_NGM_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = R_0_A,
y = R_0_S_1 + R_0_S_2)) +
geom_point() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
"_R_0_A_vs_R_0_S_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = R_0,
y = R_0_NGM,
color = b_a)) +
geom_point() +
scale_color_viridis_c() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
"_R_0_vs_R_0_NGM_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = R_0,
y = R_0_S_1 + R_0_S_2)) +
geom_point() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
"_R_0_vs_R_0_S_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = R_0_NGM,
y = Antibody_Mean_LL)) +
geom_point() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/", model_name,
"_R_0_NGM_vs_Likelihood_with_respect_to_antibody_for_all_parameter_combinations_within_2LL_of_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2head(top_2_LL_end_with_antibody_LL)## M_0 V_0 K_0 R_0 b_q b_a b_p p_S p_H_cond_S phi_E
## 1 5 13 14 5.040920 0.1199816 0.73827447 0 0.3773241 0.1767405 1.09
## 2 5 13 14 4.662393 0.1205942 0.68837081 0 0.5929974 0.1551997 1.09
## 3 5 13 14 5.579049 0.1183684 0.54631179 0 0.4603340 0.1669007 1.09
## 4 5 13 14 7.162057 0.1212649 0.44841826 0 0.2924341 0.1561453 1.09
## 5 5 13 14 7.141834 0.1235621 0.01397251 0 0.5145169 0.1537657 1.09
## 6 5 13 14 4.833856 0.1175417 0.95746195 0 0.2454977 0.1556645 1.09
## phi_U phi_S h_V gamma N_0 E_0 z_0 C_0
## 1 1.09 0.2 0.125 17.394855 8e+06 22528.90 4862.690 0
## 2 1.09 0.2 0.125 4.818495 8e+06 14264.69 3496.775 0
## 3 1.09 0.2 0.125 4.596704 8e+06 18134.69 4332.758 0
## 4 1.09 0.2 0.125 4.536257 8e+06 24722.19 7827.191 0
## 5 1.09 0.2 0.125 9.421572 8e+06 17913.11 3936.113 0
## 6 1.09 0.2 0.125 5.409624 8e+06 25495.10 9904.451 0
## social_distancing_start_time quarantine_start_time PCR_sens sigma_M
## 1 17 22 0.9 0.2814612
## 2 17 22 0.9 0.2812833
## 3 17 22 0.9 0.2813773
## 4 17 22 0.9 0.2816628
## 5 17 22 0.9 0.2831911
## 6 17 22 0.9 0.2842662
## beta_w_3 beta_w_2 beta_w_1 beta_w_0 g_0 g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## G_w_y_scaling msg iter_num param_index loglik nfail trace_num
## 1 0.162 mif1 2 1 -0.7954440 NA NA
## 2 0.162 mif1 3 1 -0.8877775 NA NA
## 3 0.162 mif1 4 1 -0.6177721 NA NA
## 4 0.162 mif1 9 1 -0.9084578 NA NA
## 5 0.162 mif1 11 1 -0.7863457 NA NA
## 6 0.162 mif1 15 1 -1.1438794 NA NA
## loglist.se Antibody_Mean_LL Antibody_LL_SE Median_Herd_Immunity
## 1 0.007197377 -69.35197 0.03117124 0.08318750
## 2 0.005469438 -114.25269 0.06406994 0.05208694
## 3 0.008664239 -88.04981 0.04744650 0.06717275
## 4 0.009767994 -51.50620 0.02663235 0.10390925
## 5 0.008395310 -100.56133 0.06835040 0.05824056
## 6 0.008197142 -39.44024 0.01943998 0.12597463
## combo_num sim_subset_index duration_of_symp_1 duration_of_symp_2
## 1 1 1 5 0.05748826
## 2 2 1 5 0.20753368
## 3 3 1 5 0.21754717
## 4 4 1 5 0.22044605
## 5 5 1 5 0.10613940
## 6 6 1 5 0.18485575
## duration_of_symp gamma_total Beta R_0_P R_0_A R_0_S_1
## 1 5.057488 0.1977266 0.9967241 0 2.29099867 1.880440
## 2 5.207534 0.1920295 0.8953170 0 1.25419913 2.654603
## 3 5.217547 0.1916609 1.0692858 0 1.57626561 2.461143
## 4 5.220446 0.1915545 1.3719244 0 2.17645831 2.005987
## 5 5.106139 0.1958427 1.3986759 0 0.04743902 3.598212
## 6 5.184856 0.1928694 0.9323030 0 3.36751198 1.144391
## R_0_S_2 R_0_NGM
## 1 0.01779941 4.189238
## 2 0.09308340 4.001886
## 3 0.08921072 4.126619
## 4 0.07463254 4.257078
## 5 0.06463742 3.710288
## 6 0.03572338 4.547627p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = p_S,
y = Antibody_Mean_LL)) +
geom_point() + rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"p_S_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = p_S,
y = Median_Herd_Immunity)) +
geom_point() + rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"p_S_vs_herd_immunity_", model_name,
"_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = R_0,
y = Antibody_Mean_LL)) +
geom_point() + rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"R_0_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = R_0,
y = Median_Herd_Immunity)) +
geom_point() + rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"R_0_vs_herd_immunity_", model_name,
"_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = b_a,
y = Antibody_Mean_LL)) +
geom_point() + rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"b_a_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = b_a,
y = Median_Herd_Immunity)) +
geom_point() + rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"b_a_vs_herd_immunity_", model_name,
"_model_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_with_antibody_LL,
aes(x = Median_Herd_Immunity,
y = Antibody_Mean_LL)) +
geom_point() + rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"herd_immunity_vs_Antibody_Mean_LL_", model_name,
"_model_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2Isloate top 2LL of antibodyLL from top 2 LL of Model N_12 Initial Fit
antibody_top_2_LL_from_grid_cases_top_2_LL = top_2_LL_end_with_antibody_LL %>%
filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)
nrow(antibody_top_2_LL_from_grid_cases_top_2_LL)## [1] 34p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
aes(x = Median_Herd_Immunity,
y = Antibody_Mean_LL)) +
geom_point() + rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"herd_immunity_vs_Antibody_Mean_LL_", model_name,
"_model_top_2_antibody_LL_from_top_2_cases_and_antibody_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
aes(x = p_S,
y = Antibody_Mean_LL)) +
rahul_man_figure_theme + geom_point()
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"p_S_vs_antibody_LL_", model_name,
"_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
aes(x = p_S,
y = R_0)) +
rahul_man_figure_theme + geom_point()
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"p_S_vs_R_0_", model_name,
"_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
aes(x = b_a,
y = R_0)) +
rahul_man_figure_theme + geom_point()
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"b_a_vs_R_0_", model_name,
"_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
aes(x = R_0_NGM)) +
geom_histogram() +
rahul_man_figure_theme
p## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"R_0_NGM_histogram_", model_name,
"_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
aes(x = R_0_A,
y = R_0_S_1 + R_0_S_2)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"R_0_A_vs_R_0_S_", model_name,
"_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
aes(x = R_0,
y = R_0_NGM,
color = b_a)) +
geom_point(size = 5) +
scale_color_viridis_c() +
rahul_man_figure_theme +
theme_white_background +
scale_x_continuous(breaks=c(seq(2,10,1), 15, 18)) +
scale_y_continuous(breaks=seq(2,5,1)) +
coord_cartesian(expand = FALSE, #turn off axis expansion (padding)
xlim = c(1.75, 9), ylim = c(1.75, 5.25)) #manually set limits
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"R_0_vs_R_0_NGM_", model_name,
"_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2png(paste0("../Figures/Profiles/", model_name, "_Model/Sup_Figs/",
"R_0_vs_R_0_NGM_", model_name,
"_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_grid_cases_top_2_LL,
aes(x = R_0,
y = R_0_S_1+ R_0_S_2)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"R_0_vs_R_0_S_", model_name,
"_model_top_2_antibody_LL_from_top_2_cases_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2–>
R over N for top parameter combinations within 2LL when fit to antibody and case data
params_with_data = join(top_2_LL_all_combo_R_data,
top_2_LL_end_with_antibody_LL)## Joining by: combo_num, sim_subset_indexparams_with_data = join(params_with_data,
top_2_LL_all_combo_S_data)## Joining by: time, combo_num, sim_subset_indexparams_with_data = join(params_with_data,
top_2_LL_all_combo_C_Q1_data)## Joining by: time, combo_num, sim_subset_indexparams_with_data = join(params_with_data,
top_2_LL_all_combo_data)## Joining by: time, combo_num, sim_subset_indexantibody_top_2_LL_params_and_sim_data = params_with_data %>%
filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)
#head(params_with_data)
all_combo_data_high_Q_max = aggregate(sim_data_R_over_N_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_R_over_N_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_R_over_N_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_R_over_N_low_Q)
all_combo_data_median_max = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_R_over_N_median)
all_combo_data_median_min = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_R_over_N_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_R_over_N_median,
ML_high_Q = sim_data_R_over_N_high_Q,
ML_low_Q = sim_data_R_over_N_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: timecomp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_max)## Joining by: timecomp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE for antibody data)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n (all 2 LL combinations (for antibody data))"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations (for antibody data))"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab
fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)
p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_median_min,
ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = ML_low_Q,
ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red"),
labels =
c("Simulation Median \n (MLE)")) +
xlab("Days since March 1 2020")+
ylab(expression(paste(frac(R,N)))) +
geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
ymax = upper_CI),
fill = 'blue',
alpha = 0.5) +
geom_point(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue') +
geom_line(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue')
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_all_params_2_LL_antibody_from_antibody_MLE_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2C_Q1
all_combo_data_high_Q_max = aggregate(sim_data_C_Q1_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_C_Q1_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_C_Q1_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_C_Q1_low_Q)
all_combo_data_median_max = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_C_Q1_median)
all_combo_data_median_min = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_C_Q1_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_C_Q1_median,
ML_high_Q = sim_data_C_Q1_high_Q,
ML_low_Q = sim_data_C_Q1_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: timecomp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_max)## Joining by: timecomp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n (all 2 LL combinations)"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations)"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab
fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)
hosp_comp_df = read.csv("../Generated_Data/hosp_comp_df.csv")
obs_hosp_df = hosp_comp_df %>%
filter(variable == "HOSPITALIZED_COUNT") %>%
dplyr::select(-Date, -Day_of_Week, time = times)
p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_median_min,
ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = ML_low_Q,
ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red"),
labels =
c("Simulation Median \n (MLE)")) +
xlab("Days since March 1 2020")+
ylab(expression(paste(C_Q1))) +
geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue')
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/Obs_COVID_hosp_cases_vs_Ribbon_Plot_C_Q1_over_time_simulation_from_all_params_2_LL_antibody_from_antibody_MLE_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2Compare to observed data
#all_combo_melt_data = melt(all_combo_data, id.vars = c("time", "combo_num"))
all_combo_data_high_Q_max = aggregate(sim_data_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_low_Q)
all_combo_data_median_max = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_median)
all_combo_data_median_min = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_median,
ML_high_Q = sim_data_high_Q,
ML_low_Q = sim_data_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)## Joining by: time## Joining by: time
true_data = dplyr::select(Observed_data, time = times,
Observed_Data = Y)
comp_data = join(comp_data, true_data)## Joining by: time## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
comp_data_melt$ML_Q_Rib_Col = "95% Simulation Quantiles \n (MLE)"
comp_data_melt$All_combo_Med_Rib_Col = "Simulation Median \n (all 2 LL combinations)"
comp_data_melt$All_combo_Q_Rib_Col = "95% Simulation Quantiles \n (all 2 LL combinations)"
fill_vec = c("Simulation Median \n (all 2 LL combinations)" = "pink", "95% Simulation Quantiles \n (MLE)" = "skyblue", "95% Simulation Quantiles \n (all 2 LL combinations)" = "grey70")
p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = ML_low_Q,
ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = all_combo_median_min,
ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red","blue"),
labels =
c("Simulation Median \n (MLE)",
"Observed",
"Data Used For Fitting")) +
xlab("Days since March 1 2020")+
ylab("Observed Monthly Cases")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_all_params_2_LL_antibody_from_antibody_MLE_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = log(all_combo_low_Q_min),
ymax = log(all_combo_high_Q_max), fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = log(ML_low_Q),
ymax = log(ML_high_Q), fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = log(all_combo_median_min),
ymax = log(all_combo_median_max), fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_line(aes(x = time, y = log(value), color = variable)) +
geom_point(aes(x = time, y = log(value), color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red","blue"),
labels =
c("Simulation Median \n (MLE)",
"Observed",
"Data Used For Fitting")) +
xlab("Days since March 1 2020")+
ylab("Observed Monthly Cases")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_all_params_2_LL_antibody_from_antibody_MLE_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2Write MLE
head(MLE)## M_0 V_0 K_0 R_0 b_q b_a b_p p_S p_H_cond_S phi_E
## 1 5 13 14 4.426536 0.1212218 0.9829669 0 0.2869619 0.1939382 1.09
## phi_U phi_S h_V gamma N_0 E_0 z_0 C_0
## 1 1.09 0.2 0.125 9.638642 8e+06 30583.41 5323.79 0
## social_distancing_start_time quarantine_start_time PCR_sens sigma_M
## 1 17 22 0.9 0.279458
## beta_w_3 beta_w_2 beta_w_1 beta_w_0 g_0 g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## G_w_y_scaling msg iter_num param_index loglik nfail trace_num
## 1 0.162 mif1 8 467 -629.0533 NA NA
## loglist.se
## 1 0.006053676head(ML_params)## M_0 V_0 K_0 R_0 b_q b_a b_p p_S p_H_cond_S phi_E
## 1 5 13 14 4.426536 0.1212218 0.9829669 0 0.2869619 0.1939382 1.09
## phi_U phi_S h_V gamma N_0 E_0 z_0 C_0
## 1 1.09 0.2 0.125 9.638642 8e+06 30583.41 5323.79 0
## social_distancing_start_time quarantine_start_time PCR_sens sigma_M
## 1 17 22 0.9 0.279458
## beta_w_3 beta_w_2 beta_w_1 beta_w_0 g_0 g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## G_w_y_scaling
## 1 0.162write.csv(ML_params,
file = "../Generated_Data/Profiles/N_12_Model/Grid_Search_MIF_run_1/ML_param_combination.csv", row.names = FALSE)
write.csv(MLE,
file = "../Generated_Data/Profiles/N_12_Model/Grid_Search_MIF_run_1/MLE_param_combination_with_LL.csv", row.names = FALSE)Get param grid box for profiles
#head(top_20_LL_end_params)
top_20_LL_box = top_20_LL_end_params %>%
filter(loglist.se < 2) %>%
sapply(range)
write.csv(top_20_LL_box, file = "../Generated_Data/Profile_Combination_Lists/N_12_Model/original_20_LL_param_box_from_1st_MIF_run.csv",
row.names = FALSE)Combine output from profiles
# ---- combine_profile_output ----
# Header ------------------------------------------------------------------
## Name: combine_profile_output.R
## Author: Rahul Subramanian
## Description: Combine MIF real profile output data into one big data frame
combine_profile_output = function(profile_var, model_name){
ptm = proc.time()
#profile_var = "I_S_0"
#args = commandArgs(trailingOnly=TRUE)
#profile_var = as.character(args[1])
print(profile_var)
###Load parameter list
pd = read.csv(file = paste0("../Generated_Data/Profile_Combination_Lists/",
model_name,"_Model/",profile_var,"_",
model_name,
"_profile_combination_list.csv"),
header = TRUE)
#head(pd)
mif_sim_combined_output_df = data.frame(
matrix(nrow = 0, ncol = ncol(pd) + 7)
)
colnames(mif_sim_combined_output_df) = c(colnames(pd), "LL")
colnames(mif_sim_combined_output_df) = c(colnames(pd),"msg", "iter_num", "param_index", "loglik", "nfail", "trace_num", "loglist.se")
midway_max_jobs = 500
for(param_index in seq(1:midway_max_jobs)){
#print(param_index)
input_file_name = paste0("../Generated_Data/Profiles/", model_name,
"_Model/",profile_var,"_Profile/Subset_Outputs/",profile_var,
"_", model_name,
"_Profile_subset_",param_index,".RData")
if(file.exists(input_file_name) == TRUE){
load(file = input_file_name)
mif_output_df_single_subset = res
}else{
group_size = nrow(pd)/midway_max_jobs
start_index = (param_index-1)*group_size + 1
end_index = param_index*group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(seq_len(nrow(param_data_subset_act)), each = Num_mif_runs_per_start),]
#param_data_subset$seed = NA;
param_data_subset$msg = NA
param_data_subset$iter_num = NA
param_data_subset$param_index = NA
param_data_subset$nfail = NA
param_data_subset$trace_num = NA
param_data_subset$loglik = NA
param_data_subset$loglist.se = NA
mif_output_df_single_subset = param_data_subset
}
#head(mif_output_df_single_subset)
mif_sim_combined_output_df = rbind(mif_sim_combined_output_df, mif_output_df_single_subset)
}
output_file_name = paste0("../Generated_Data/Profiles/", model_name,"_Model/", profile_var, "_Profile/",
profile_var, "_", model_name, "_profile_combined_data_including_traces_and_start.RData")
save(mif_sim_combined_output_df, file = output_file_name)
profile_data_no_traces_or_start = filter(mif_sim_combined_output_df,
msg == "mif1")
output_file_name = paste0("../Generated_Data/Profiles/", model_name,"_Model/", profile_var, "_Profile/",
profile_var, "_", model_name, "_profile_combined_data.csv")
write.csv(profile_data_no_traces_or_start, file = output_file_name, row.names=FALSE,na="")
}
combine_profile_output(profile_var = "G_w_y_scaling", model_name = model_name)## [1] "G_w_y_scaling"# combine_profile_output(profile_var = "z_0", model_name = model_name)
# combine_profile_output(profile_var = "E_0", model_name = model_name)
# combine_profile_output(profile_var = "R_0", model_name = model_name)
combine_profile_output(profile_var = "b_a", model_name = model_name)## [1] "b_a"# combine_profile_output(profile_var = "b_e", model_name = model_name)
# combine_profile_output(profile_var = "b_q", model_name = model_name)
# combine_profile_output(profile_var = "p_S", model_name = model_name)
# combine_profile_output(profile_var = "p_H_cond_S", model_name = model_name)
# combine_profile_output(profile_var = "gamma", model_name = model_name)
# combine_profile_output(profile_var = "sigma_M", model_name = model_name)Profile over b_a (SEPIAR Model)
Code to generate profile combinations
knitr::read_chunk('generate_profile_combinations_covid_nyc_N_12.R')# Header ------------------------------------------------------------------
## Name: generate_profile_combinations_covid_NYC_N_12.R
## Author: Rahul Subramanian
## Description: Creates 30*40-combination list for given by profile_var as 1st command line argument
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
library(stringr)
args = commandArgs(trailingOnly=TRUE)
#model_name = "N_12"
#profile_var = "b_a"
profile_var = as.character(args[1])
print(profile_var)
model_name = as.character(args[2])
print(model_name)
#Load box
top_20_LL_box = read.csv(
file = paste0("../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/original_20_LL_param_box_from_1st_MIF_run.csv"))
#Modify G_w_y_scaling box boundaries
par_box_boundaries = top_20_LL_box %>%
dplyr::select(-msg, -iter_num, -param_index, -loglik, -nfail, -trace_num,
-loglist.se)
if(profile_var == "G_w_y_scaling"){
par_box_boundaries$G_w_y_scaling = c(0,0.33)
}else{
if(profile_var == 'b_a'){
par_box_boundaries$b_a = c(0,1)
par_box_boundaries$b_p = c(0,1)
}else{
}
}
par_box_boundaries_clean = dplyr::select(par_box_boundaries, -one_of(profile_var) )
theta.t.lo = as.numeric(as.vector(par_box_boundaries_clean[1,]))
theta.t.hi = as.numeric(as.vector(par_box_boundaries_clean[2,]))
names(theta.t.lo) = colnames(par_box_boundaries_clean)
names(theta.t.hi) = colnames(par_box_boundaries_clean)
prof_var_boundaries = dplyr::select(par_box_boundaries, one_of(profile_var))
profileDesign(
prof_var=seq(from=prof_var_boundaries[1,],to=prof_var_boundaries[2,],length=30),
lower=theta.t.lo,upper=theta.t.hi,nprof=40
) -> pd
pd_col = colnames(pd)
colnames(pd) = c(profile_var, pd_col[2:length(pd_col)])
write.csv(pd, file = paste0("../Generated_Data/Profile_Combination_Lists/",
model_name,"_Model/", profile_var,"_",
model_name,
"_profile_combination_list.csv"),
append = FALSE, row.names = FALSE)
proc.time() - ptmCode to run MIF for profile (SEPIAR Model)
knitr::read_chunk('MIF_run_Profile_Model_N_12.R')# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
profile_var = as.character(args[1])
print(profile_var)
model_name = as.character(args[2])
print(model_name)
#model_name = "N_12"
#profile_var = "b_a"
#param_index = 1
#i = 1
#Load Observed NYC case data
Observed_data = read.csv(paste0(
"../Generated_Data/observed_data_",
model_name, ".csv"))
head(Observed_data)
### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")
## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14
#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")
## Load NYC covariate data
covariate_df = read.csv(file =
paste0("../Generated_Data/covariate_data_",
model_name, ".csv"))
### Create covariate table
covar=covariate_table(
time=covariate_df$times,
L_advanced_2_days=covariate_df$L_advanced_2_days,
F_w_y = covariate_df$F_w_y,
L_orig = covariate_df$L_orig,
w = covariate_df$Week,
y = covariate_df$Year,
times="time"
)
require(foreach)
require(doParallel)
require(deSolve)
#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
assinged_cores = 1
cat("assinged_cores = ", assinged_cores, "\n")
cl <- makeCluster(assinged_cores)
registerDoParallel(cl)
param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)
##load(param_grid)
pd = read.csv(
file = paste0(
"../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/",
profile_var,
"_",
model_name,
"_profile_combination_list.csv"
),
header = TRUE
)
head(pd)
midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
seq_len(nrow(param_data_subset_act)),
each = Num_mif_runs_per_start),]
rw_sd_list_default = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
get_rwsd = function(profile_var){
if(profile_var == "G_w_y_scaling"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0,
M_0 = 0,
phi_U = 0)
}else{
if(profile_var == "R_0"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02,
M_0 = 0,
phi_U = 0,)
}else{
if(profile_var == "b_a"){
rw.sd = rw.sd(
M_0 = 0,
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_U = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
b_p = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
}else{
if(profile_var == "p_S"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0,
p_H_cond_S = 0.02,
b_p = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "p_H_cond_S"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
b_p = 0.02,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "E_0"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "z_0"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
b_p = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "gamma"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
b_p = 0.02,
gamma = 0,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "b_q"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
b_p = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
stop("Profile var not specified in rwsd wrapper function")
}
}
}
}
}
}
}
}
}
}
rw.sd = get_rwsd(profile_var = profile_var)
detail_log = FALSE
if (detail_log == TRUE) {
detailed_log_file_name = paste0(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
profile_var,
"_Profile/Detailed_Log/log_file_subset_",
param_index,
".txt"
)
write(file = detailed_log_file_name,
paste0("Log generated on ", Sys.time(), " \n"),
append = FALSE)
}
mif_single_subset_data <-
foreach(
i = 1:nrow(param_data_subset),
.combine = rbind,
.packages = c('pomp', 'dplyr'),
.export = c(
"rproc",
"rmeas",
"dmeas",
"init",
"paramnames",
"statenames",
"obsnames",
"param_data_subset",
"par_trans",
"acumvarnames",
"covar"
)
) %dopar%
{
tryCatch({
print(param_data_subset[i,])
print("iter_num")
print(i)
print("param_index")
print(param_index)
params = param_data_subset[i,]
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
seed <- round(runif(1, min = 1, max = 2 ^ 30))
#seed = 565013131
mif_single_param_output <- mif2(
data = Observed_data,
times = Observed_data$times,
t0 = t0,
seed = seed,
rproc = pomp::euler(rproc, delta.t = 1),
params = params,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
tol = 0,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
start = params,
Np = 10000,
Nmif = 50,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd
)
first_trace_df = mif_single_param_output@traces %>%
as.data.frame()
first_trace_df$trace_num = seq(1:nrow(first_trace_df))
# trace_df_ll = trace_df %>%
# dplyr::select(loglik, nfail)
# trace_df_no_ll = trace_df %>%
# dplyr::select(-loglik, -nfail)
# trace_df = trace_df_no_ll %>%
# mutate(nfail = trace_df_ll$nfail,
# loglik = trace_df_ll$loglik)
first_trace_df$loglik
first_trace_df$loglist.se = NA
first_trace_df$iter_num = i
first_trace_df$param_index = param_index
first_trace_df$msg = "first_trace"
mif_second_round = mif_single_param_output %>%
mif2(Nmif = 50)
second_trace_df = mif_second_round@traces %>%
as.data.frame()
second_trace_df$trace_num = seq(1:nrow(second_trace_df))
second_trace_df$loglik
second_trace_df$loglist.se = NA
second_trace_df$iter_num = i
second_trace_df$param_index = param_index
second_trace_df$msg = "second_trace"
ll <- tryCatch(
replicate(n = 10, logLik(
pfilter(
data = Observed_data,
times = Observed_data$times,
t0 = t0,
rprocess = pomp::euler(rproc, delta.t = 1),
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
format = "data.frame",
Np = 50000,
params = coef(mif_second_round)
)
)),
error = function(e)
e
)
fin = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
if (is(ll, "error")) {
} else{
ll_with_se = logmeanexp(ll, se = TRUE)
if (detail_log == TRUE) {
log_str = paste0(log_str,
"pfilter_warnings: \n ",
warnings(),
" \n Done with warnings \n")
}
}
if (is.na(ll_with_se[[1]])) {
} else{
fin$loglik = ll_with_se[[1]]
fin$loglist.se = ll_with_se[[2]]
}
fin$iter_num = i
fin$param_index = param_index
fin$msg = "mif1"
start_and_trace = bind_rows(start, first_trace_df)
start_and_trace = bind_rows(start_and_trace, second_trace_df)
bind_rows(start_and_trace, fin)
},
error = function (e) {
warning("Inside error function")
print("iter_num")
print(i)
print("param_index")
print(param_index)
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
start$loglik = NA
start$nfail = NA
start$trace_num = NA
start$loglist.se = NA
fin = start
fin$msg = conditionMessage(e)
full_join(start, fin, by = names(start))
})
} -> res
output_name = paste(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
profile_var,
"_Profile/Subset_Outputs/",
profile_var,
"_",
model_name,
"_Profile_subset_",
param_index,
".RData",
sep = ""
)
if (detail_log == TRUE) {
write(file = detailed_log_file_name, log_output, append = TRUE)
}
save(res, file = output_name)
res
proc.time() - ptmScript to execute code for b_a profile MIF run on Midway computing cluster
cat Midway_script_Model_N_12_b_a_Profile.sbatch#!/bin/bash
#SBATCH --job-name=b_a_N_12
#SBATCH --output=b_a_N_12_%A_%a.out
#SBATCH --error=error_b_a_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=1
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000
echo $SLURM_ARRAY_TASK_ID
module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args b_a N_12' MIF_run_Profile_Model_N_12.R OUT_b_a/out.$SLURM_ARRAY_TASK_ID Script to execute code for G_w_y_scaling profile MIF run on Midway computing cluster
cat Midway_script_Model_N_12_G_w_y_scaling_Profile.sbatch#!/bin/bash
#SBATCH --job-name=G_w_y_scaling_N_12
#SBATCH --output=G_w_y_scaling_N_12_%A_%a.out
#SBATCH --error=error_G_w_y_scaling_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=1
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000
echo $SLURM_ARRAY_TASK_ID
module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args G_w_y_scaling N_12' MIF_run_Profile_Model_N_12.R OUT_G_w_y_scaling/out.$SLURM_ARRAY_TASK_ID Plot profiles
For each profile, three plots are generated. The first plot(“all_clean_data_points”) shows the likelihoods of every MIF run conducted for that profile. The second plot is the actual plot of the profile. For the second plot, only the maximum likelihood of each profiled parameter value is shown on the plot. The third plot is a “zoom-in” of the region near the MLE, only showing combinations within 20 log-likelihood units of the MLE. On all three plots, red horizontal lines denote likelihood values 20 log-likelihood units below the profile MLE, while blue horizontal lines denote likelihood values 2 log-likelihood units below the MLE.
Plotting function
plot_profiles = function(profile_var, model_name){
#Load results
profile_data = read.csv(file = paste0("../Generated_Data/Profiles/", model_name, "_Model/", profile_var, "_Profile/",
profile_var, "_", model_name, "_profile_combined_data.csv"))
#head(profile_data)
na_data = filter(profile_data, is.na(loglik) == TRUE)
print(paste("There are ", nrow(na_data), " entries with NA likelihoods"))
profile_data_clean = filter(profile_data, is.na(loglik) == FALSE)
ML = max(profile_data_clean$loglik)
cutoff_thres_20_LL_from_ML = ML - 20
p = ggplot(data = profile_data_clean, aes_string(x = eval(profile_var), y = "loglik")) + geom_point() + geom_hline(yintercept = cutoff_thres_20_LL_from_ML,
color = 'red')+
rahul_theme
print(p)
png(paste0("../Figures/Profiles/", model_name, "_Model/", profile_var, "_Profile/all_clean_data_points_",
profile_var,"_", model_name, "_profile.png"))
print(p)
dev.off()
cutoff_thres_2_LL_from_ML = ML - 2
### Take trace of profile (max at each value of profile variable)
profile_var_profile = aggregate(formula(paste0("loglik ~ ",eval(profile_var))), profile_data_clean, max)
#head(profile_var_profile)
p = ggplot(data = profile_var_profile, aes_string(x = eval(profile_var), y = "loglik")) +
geom_point(size = 3) + geom_hline(yintercept = cutoff_thres_20_LL_from_ML, color = 'red') + rahul_theme
print(p)
png(paste0("../Figures/Profiles/", model_name, "_Model/", profile_var, "_Profile/full_",
profile_var, "_", model_name, "_profile.png"))
print(p)
dev.off()
top_20_LL_units = filter(profile_var_profile, loglik > cutoff_thres_20_LL_from_ML)
p = ggplot(data = top_20_LL_units, aes_string(x = eval(profile_var), y = "loglik")) +
geom_point() + geom_hline(yintercept = cutoff_thres_2_LL_from_ML,color = 'blue') +
rahul_theme + theme_white_background +
ylab("Log Likelihood")
if(profile_var == "G_w_y_scaling"){
p = p + xlab("s")
}
print(p)
png(paste0("../Figures/Profiles/", model_name, "_Model/", profile_var, "_Profile/20_LL_from_ML_",
profile_var, "_", model_name, "_profile.png"))
print(p)
dev.off()
}\(b_a\) Profile
plot_profiles(profile_var = "b_a", model_name = model_name)## [1] "There are 0 entries with NA likelihoods"
## quartz_off_screen
## 2\(G_w_y_scaling\) Profile
plot_profiles(profile_var = "G_w_y_scaling", model_name = model_name)## [1] "There are 0 entries with NA likelihoods"
## quartz_off_screen
## 2{r} # plot_profiles(profile_var = "R_0", model_name = model_name) #
{r} # plot_profiles(profile_var = "E_0", model_name = model_name) #
profile_var = "G_w_y_scaling"
profile_data= read.csv(file = paste0("../Generated_Data/Profiles/", model_name, "_Model/", profile_var, "_Profile/",
profile_var, "_", model_name, "_profile_combined_data.csv"))
profile_peak_data_G_w_y_scaling = profile_data %>%
filter(loglik > max(loglik)-2)
range(profile_peak_data_G_w_y_scaling$R_0)## [1] 4.708381 11.298709save(profile_peak_data_G_w_y_scaling, file = paste0("../Generated_Data/Profiles/",
model_name,
"_Model/G_w_y_scaling_Profile/top_2_LL_of_G_w_y_scaling_profile.RData"))
profile_peak_data_5LL = profile_data %>%
filter(loglik > max(loglik)-5)
range(profile_peak_data_5LL$R_0)## [1] 3.685955 22.641192profile_var = "b_a"
profile_data= read.csv(file = paste0("../Generated_Data/Profiles/", model_name, "_Model/", profile_var, "_Profile/",
profile_var, "_", model_name, "_profile_combined_data.csv"))
profile_peak_data_b_a = profile_data %>%
filter(loglik > max(loglik)-2)
range(profile_peak_data_b_a$R_0)## [1] 2.876945 18.378599save(profile_peak_data_b_a, file = paste0("../Generated_Data/Profiles/",
model_name,
"_Model/b_a_Profile/top_2_LL_of_b_a_profile.RData"))
profile_peak_data = profile_data %>%
filter(loglik > max(loglik)-5)
range(profile_peak_data$R_0)## [1] 2.876945 21.734214p = ggplot(data = profile_peak_data,
aes(x = G_w_y_scaling,
y = R_0)) +
geom_point() +
rahul_theme
p
p = ggplot(data = profile_peak_data,
aes(x = G_w_y_scaling,
y = p_S)) +
geom_point() +
rahul_theme
p
p = ggplot(data = profile_peak_data,
aes(x = b_a,
y = b_p,
color = p_S < .15)) +
geom_point() +
rahul_theme
p
p = ggplot(data = profile_peak_data,
aes(x = b_a,
y = p_S)) +
geom_point() +
rahul_theme
p
p = ggplot(data = profile_peak_data,
aes(x = R_0,
y = p_S)) +
geom_point() +
rahul_theme
p
p = ggplot(data = profile_peak_data,
aes(x = p_S,
y = log(R_0))) +
geom_point() + geom_hline(yintercept = log(3), color = 'orange') +
geom_hline(yintercept = log(4), color = 'purple') +
rahul_theme
p
range(profile_peak_data$p_S)## [1] 0.09939145 0.70221737png("../Figures/Profiles/N_12_Model/b_a_Profile/p_S_vs_log_R_0_b_a_Profile_data.png")
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = profile_peak_data,
aes(x = b_a,
y = log(R_0))) +
geom_point() + geom_hline(yintercept = log(3), color = 'orange') +
geom_hline(yintercept = log(4), color = 'purple') +
rahul_theme
p
png("../Figures/Profiles/N_12_Model/b_a_Profile/b_a_vs_log_R_0_b_a_Profile_data.png")
print(p)
dev.off()## quartz_off_screen
## 2small_R_0_profile_peak_params = profile_peak_data %>%
filter(R_0 <= 3)
range(small_R_0_profile_peak_params$p_S)## [1] 0.1567483 0.6246020Plot Antibody LL for Profile Peaks
Simulate at b_a profile peak
source("Sim_b_a_profile_peak_Model_N_12.R")Code for simulations
knitr::read_chunk('Sim_b_a_profile_peak_Model_N_12.R')#rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
#model_name = as.character(args[1])
#print(model_name)
profile_var = "b_a"
model_name = "N_12"
#param_index = 1
#i = 1
#Load Observed NYC case data
Observed_data = read.csv(paste0(
"../Generated_Data/observed_data_",
model_name, ".csv"))
head(Observed_data)
### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")
## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14
#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")
## Load NYC covariate data
covariate_df = read.csv(file =
paste0("../Generated_Data/covariate_data_",
model_name, ".csv"))
### Create covariate table
covar=covariate_table(
time=covariate_df$times,
L_advanced_2_days=covariate_df$L_advanced_2_days,
F_w_y = covariate_df$F_w_y,
L_orig = covariate_df$L_orig,
w = covariate_df$Week,
y = covariate_df$Year,
times="time"
)
param_index = 1
head(profile_peak_data_b_a)
##load(param_grid)
load(file = paste0(
"../Generated_Data/Profiles/", model_name,
"_Model/",
profile_var,
"_Profile/top_2_LL_of_",
profile_var,
"_profile.RData"))
profile_peak_data = profile_peak_data_b_a
midway_max_jobs = 1
group_size = nrow(profile_peak_data) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_sim_runs_per_start = 1
top_2_LL_end_data_subset_act = profile_peak_data[start_index:end_index,]
top_2_LL_end_data_subset = top_2_LL_end_data_subset_act[rep(
seq_len(nrow(top_2_LL_end_data_subset_act)),
each = Num_sim_runs_per_start),]
## Load Antibdoy data
nyc_antibdoy_df = read.csv("../Generated_Data/antibody_data_from_nyc_study_with_RS_calc_CI.csv")
head(nyc_antibdoy_df)
# Top 2 LL
top_2_LL_end_subset_with_antibody_LL =
data.frame(matrix(nrow = 0,
ncol = ncol(top_2_LL_end_data_subset) + 5))
colnames(top_2_LL_end_subset_with_antibody_LL) =
c(colnames(top_2_LL_end_data_subset), "Antibody_Mean_LL", "Antibody_LL_SE","Median_Herd_Immunity",
"sim_subset_index", "combo_num")
all_combo_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_data) = c("time", "sim_data_median ", "sim_data_low_Q",
"sim_data_high_Q","combo_num", "sim_subset_index")
all_combo_S_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_S_data) = c("time", "sim_data_S_over_N_median ", "sim_data_S_over_N_low_Q",
"sim_data_S_over_N_high_Q","combo_num", "sim_subset_index")
all_combo_beta_t_data = data.frame(matrix(nrow = 0, ncol = 4))
colnames(all_combo_beta_t_data) = c("time", "sim_data_beta_t_median ",
"combo_num", "sim_subset_index")
all_combo_C_Q1_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_C_Q1_data) = c("time", "sim_data_C_Q1_median ", "sim_data_C_Q1_low_Q",
"sim_data_C_Q1_high_Q","combo_num", "sim_subset_index")
all_combo_R_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_R_data) = c("time", "sim_data_R_over_N_median ", "sim_data_R_over_N_low_Q",
"sim_data_R_over_N_high_Q","combo_num", "sim_subset_index")
for(combo_index in seq(1:nrow(top_2_LL_end_data_subset))){
#print(combo_index)
combo_params = top_2_LL_end_data_subset[combo_index,]
combo_params = dplyr::select(combo_params, -one_of(
"msg", "iter_num", "param_index","loglik", "nfail", "trace_num", "loglist.se"))
sim_data_sample_param = simulate(nsim = 100,
seed = 12345,
times = Observed_data$times,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = combo_params,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
format = "data.frame")
#head(sim_data)
sim_data_sample_param_median_Y = aggregate(Y ~ time, sim_data_sample_param, median)
sim_data_sample_param_quant = aggregate(Y ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
sim_data_sample_param_quant$Y = as.data.frame(sim_data_sample_param_quant$Y)
colnames(sim_data_sample_param_quant$Y) = c("Q2.5", "Q97.5")
combo_num = rep(combo_index, nrow(sim_data_sample_param_median_Y))
sim_subset_index = rep(param_index, nrow(sim_data_sample_param_median_Y))
single_combo_data = data.frame(time = sim_data_sample_param_median_Y$time,
sim_data_median = sim_data_sample_param_median_Y$Y,
sim_data_low_Q = sim_data_sample_param_quant$Y$Q2.5,
sim_data_high_Q = sim_data_sample_param_quant$Y$Q97.5,
combo_num = combo_num,
sim_subset_index = sim_subset_index)
all_combo_data = rbind(all_combo_data, single_combo_data)
sim_data_sample_param$S_over_N = sim_data_sample_param$S/sim_data_sample_param$N
sim_data_S_over_N_median = aggregate(S_over_N ~ time, sim_data_sample_param, median)
sim_data_sample_param_S_over_N_quant = aggregate(S_over_N ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
sim_data_sample_param_S_over_N_quant$S_over_N = as.data.frame(sim_data_sample_param_S_over_N_quant$S_over_N)
colnames(sim_data_sample_param_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")
sim_data_sample_param_S_over_N_quant = aggregate(S_over_N ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
sim_data_sample_param_S_over_N_quant$S_over_N = as.data.frame(sim_data_sample_param_S_over_N_quant$S_over_N)
colnames(sim_data_sample_param_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")
single_combo_S_data = data.frame(time = sim_data_sample_param_median_Y$time,
sim_data_S_over_N_median = sim_data_S_over_N_median$S_over_N,
sim_data_S_over_N_low_Q = sim_data_sample_param_S_over_N_quant$S_over_N$Q2.5,
sim_data_S_over_N_high_Q = sim_data_sample_param_S_over_N_quant$S_over_N$Q97.5,
combo_num = combo_num,
sim_subset_index = sim_subset_index)
all_combo_S_data = rbind(all_combo_S_data, single_combo_S_data)
sim_data_beta_t_median = aggregate(beta_t ~ time, sim_data_sample_param, median)
single_combo_beta_t_data = data.frame(time = sim_data_sample_param_median_Y$time,
sim_data_beta_t_median = sim_data_beta_t_median$beta_t,
combo_num = combo_num,
sim_subset_index = sim_subset_index)
all_combo_beta_t_data = rbind(all_combo_beta_t_data, single_combo_beta_t_data)
sim_data_C_Q1_median = aggregate(C_Q1 ~ time, sim_data_sample_param, median)
sim_data_sample_param_C_Q1_quant = aggregate(C_Q1 ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
sim_data_sample_param_C_Q1_quant$C_Q1 = as.data.frame(sim_data_sample_param_C_Q1_quant$C_Q1)
colnames(sim_data_sample_param_C_Q1_quant$C_Q1) = c("Q2.5", "Q97.5")
single_combo_C_Q1_data = data.frame(time = sim_data_sample_param_median_Y$time,
sim_data_C_Q1_median = sim_data_C_Q1_median$C_Q1,
sim_data_C_Q1_low_Q = sim_data_sample_param_C_Q1_quant$C_Q1$Q2.5,
sim_data_C_Q1_high_Q = sim_data_sample_param_C_Q1_quant$C_Q1$Q97.5,
combo_num = combo_num,
sim_subset_index = sim_subset_index)
all_combo_C_Q1_data = rbind(all_combo_C_Q1_data, single_combo_C_Q1_data)
rel_columns = sim_data_sample_param %>%
dplyr::select(R_A, R_F, R_H, time, .id, N)
sim_data_sample_param_modified = rel_columns %>%
mutate(R_sum = R_A + R_F + R_H)
sim_data_sample_param_modified$R_over_N = sim_data_sample_param_modified$R_sum/sim_data_sample_param_modified$N
sim_data_R_over_N_median = aggregate(R_over_N ~ time, sim_data_sample_param_modified, median)
sim_data_sample_param_R_over_N_quant = aggregate(R_over_N ~ time, sim_data_sample_param_modified,
quantile, probs = c(0.025, 0.975))
sim_data_sample_param_R_over_N_quant$R_over_N = as.data.frame(sim_data_sample_param_R_over_N_quant$R_over_N)
colnames(sim_data_sample_param_R_over_N_quant$R_over_N) = c("Q2.5", "Q97.5")
single_combo_R_data = data.frame(
time = sim_data_sample_param_median_Y$time,
sim_data_R_over_N_median = sim_data_R_over_N_median$R_over_N,
sim_data_R_over_N_low_Q = sim_data_sample_param_R_over_N_quant$R_over_N$Q2.5,
sim_data_R_over_N_high_Q = sim_data_sample_param_R_over_N_quant$R_over_N$Q97.5,
combo_num = combo_num,
sim_subset_index = sim_subset_index)
all_combo_R_data = rbind(all_combo_R_data, single_combo_R_data)
nyc_antibody_df = nyc_antibdoy_df %>%
mutate(time = times)
sim_data_sample_param_for_antibody_comp = sim_data_sample_param_modified %>%
dplyr::select(time, R_over_N, sim_id = .id)
sim_data_sample_param_with_antibody_df = inner_join(
sim_data_sample_param_for_antibody_comp,
nyc_antibody_df,
by = c("time"))
### Exclude first antibody observation on March 1st-The simulation just started
#on that date.
sim_data_sample_param_with_antibody_df = sim_data_sample_param_with_antibody_df %>%
filter(time > 0)
## Calculate LL
sim_data_sample_param_with_antibody_df = sim_data_sample_param_with_antibody_df %>%
mutate(Antibody_LL = dbinom(x = Num_Positive, p = R_over_N, size = Num_Sampled,
log = TRUE))
antibody_LL_per_sim_run = sim_data_sample_param_with_antibody_df %>%
group_by(sim_id) %>%
summarize(LL_per_run = sum(Antibody_LL)) %>%
as.data.frame()
total_antibody_LL_for_combination = logmeanexp(antibody_LL_per_sim_run$LL_per_run,
se = TRUE)
single_param_with_antibody_LL = top_2_LL_end_data_subset[combo_index,]
single_param_with_antibody_LL$Antibody_Mean_LL = total_antibody_LL_for_combination[[1]]
single_param_with_antibody_LL$Antibody_LL_SE = total_antibody_LL_for_combination[[2]]
single_param_with_antibody_LL$Median_Herd_Immunity =
sim_data_R_over_N_median$R_over_N[nrow(sim_data_R_over_N_median)]
single_param_with_antibody_LL$combo_num = combo_index
single_param_with_antibody_LL$sim_subset_index = param_index
top_2_LL_end_subset_with_antibody_LL = rbind(top_2_LL_end_subset_with_antibody_LL,
single_param_with_antibody_LL)
}
save(all_combo_data,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_sim_cases_data.RData"))
save(all_combo_S_data,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_sim_S_over_N_data.RData"
))
save(all_combo_beta_t_data,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_sim_beta_t_data.RData"
))
save(all_combo_R_data,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_sim_R_over_N_data.RData"
))
save(all_combo_C_Q1_data,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_sim_C_Q_1_data.RData"))
save(top_2_LL_end_subset_with_antibody_LL,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_with_antibody_LL.RData"))R over N for top parameter combinations within 2LL when fit to antibody and case data (b_a Profile)
params_with_data = join(all_combo_R_data,
top_2_LL_end_subset_with_antibody_LL)## Joining by: combo_num, sim_subset_indexparams_with_data = join(params_with_data,
all_combo_S_data)## Joining by: time, combo_num, sim_subset_indexparams_with_data = join(params_with_data,
all_combo_C_Q1_data)## Joining by: time, combo_num, sim_subset_indexparams_with_data = join(params_with_data,
all_combo_data)## Joining by: time, combo_num, sim_subset_indexantibody_top_2_LL_params_and_sim_data = params_with_data %>%
filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)
#head(params_with_data)
all_combo_data_high_Q_max = aggregate(sim_data_R_over_N_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_R_over_N_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_R_over_N_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_R_over_N_low_Q)
all_combo_data_median_max = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_R_over_N_median)
all_combo_data_median_min = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_R_over_N_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_R_over_N_median,
ML_high_Q = sim_data_R_over_N_high_Q,
ML_low_Q = sim_data_R_over_N_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: timecomp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_max)## Joining by: timenyc_antibody_df = nyc_antibody_df %>%
filter(time > 0)
comp_data = comp_data %>%
filter(time <= max(nyc_antibody_df$time)) %>%
filter(time >= min(nyc_antibody_df$time))
comp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE for antibody data)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n (all 2 LL combinations (for antibody data))"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations (for antibody data))"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab
fill_vec = c("pink", "skyblue", "red")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)
p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
alpha = 0.5), inherit.aes = FALSE) +
# geom_ribbon(data = comp_data_melt,
# aes(x = time, ymin = all_combo_median_min,
# ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
# geom_ribbon(data = comp_data_melt,
# aes(x = time, ymin = ML_low_Q,
# ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red"),
labels =
c("Simulation Median \n (MLE)")) +
xlab("Days since March 1 2020")+
ylab(expression(paste(frac(R,N)))) +
geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
ymax = upper_CI),
fill = 'blue',
alpha = 0.5) +
geom_point(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue') +
geom_line(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue') +
theme(legend.position = "None") +
theme(axis.title.x = element_text(face = "plain", size = 24),
axis.title.y = element_text(face = "plain", size = 24)) +
theme(axis.line = element_line(colour = 'black', size = 1))+
theme(axis.ticks = element_line(colour = "black", size = 1.5)) +
theme(axis.text.x = element_text(size=21)) +
theme(axis.text.y = element_text(size=21))
# xlab("")+
# ylab("")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2png(paste0("../Figures/Profiles/", model_name,
"_Model/Man_Figs/b_a_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2pdf(paste0("../Figures/Profiles/", model_name,
"_Model/Man_Figs/b_a_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.pdf"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
alpha = 0.5), inherit.aes = FALSE) +
# geom_ribbon(data = comp_data_melt,
# aes(x = time, ymin = all_combo_median_min,
# ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
# geom_ribbon(data = comp_data_melt,
# aes(x = time, ymin = ML_low_Q,
# ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red"),
labels =
c("Simulation Median \n (MLE)")) +
xlab("Days since March 1 2020")+
ylab(expression(paste(frac(R,N)))) +
geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
ymax = upper_CI),
fill = 'blue',
alpha = 0.5) +
geom_point(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue') +
geom_line(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue') +
theme(legend.position = "None") +
theme(axis.title.x = element_text(face = "plain"),
axis.title.y = element_text(face = "plain")) +
xlab("")+
ylab("") +
theme(axis.line = element_line(colour = 'black', size = 1))+
theme(axis.ticks = element_line(colour = "black", size = 1.5))
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/Man_Figs/b_a_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params_no_labs.png"))
print(p)
dev.off()## quartz_off_screen
## 2C_Q1 (b_a Profile)
Top 2LL via cases data
all_combo_data_high_Q_max = aggregate(sim_data_C_Q1_high_Q ~ time, params_with_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_C_Q1_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_C_Q1_low_Q ~ time, params_with_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_C_Q1_low_Q)
all_combo_data_median_max = aggregate(sim_data_C_Q1_median ~ time, params_with_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_C_Q1_median)
all_combo_data_median_min = aggregate(sim_data_C_Q1_median ~ time, params_with_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_C_Q1_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_C_Q1_median,
ML_high_Q = sim_data_C_Q1_high_Q,
ML_low_Q = sim_data_C_Q1_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: timecomp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_max)## Joining by: timecomp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n (all 2 LL combinations)"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations)"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab
fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)
hosp_comp_df = read.csv("../Generated_Data/hosp_comp_df.csv")
obs_hosp_df = hosp_comp_df %>%
filter(variable == "HOSPITALIZED_COUNT") %>%
dplyr::select(-Date, -Day_of_Week, time = times)
p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_median_min,
ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = ML_low_Q,
ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red"),
labels =
c("Simulation Median \n (MLE)")) +
xlab("Days since March 1 2020")+
ylab(expression(paste(C_Q1))) +
geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue')
p
### Only top 2LL params via antibody LL
all_combo_data_high_Q_max = aggregate(sim_data_C_Q1_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_C_Q1_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_C_Q1_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_C_Q1_low_Q)
all_combo_data_median_max = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_C_Q1_median)
all_combo_data_median_min = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_C_Q1_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_C_Q1_median,
ML_high_Q = sim_data_C_Q1_high_Q,
ML_low_Q = sim_data_C_Q1_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: timecomp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_max)## Joining by: timecomp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n (all 2 LL combinations)"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations)"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab
fill_vec = c("pink", "skyblue", "red")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)
hosp_comp_df = read.csv("../Generated_Data/hosp_comp_df.csv")
obs_hosp_df = hosp_comp_df %>%
filter(variable == "HOSPITALIZED_COUNT") %>%
dplyr::select(-Date, -Day_of_Week, time = times)
obs_resp_df = hosp_comp_df %>%
filter(variable == "Count") %>%
dplyr::select(-Date, -Day_of_Week, time = times)
obs_resp_likely_COVID_df = hosp_comp_df %>%
filter(variable == "daily_est_COVID_resp") %>%
dplyr::select(-Date, -Day_of_Week, time = times)
p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
alpha = 0.5), inherit.aes = FALSE) +
# geom_ribbon(data = comp_data_melt,
# aes(x = time, ymin = all_combo_median_min,
# ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
# geom_ribbon(data = comp_data_melt,
# aes(x = time, ymin = ML_low_Q,
# ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red"),
labels =
c("Simulation Median \n (MLE)")) +
xlab("Days since March 1 2020")+
ylab(expression(paste("Daily new hospitalized cases (", C[Q1], ")"))) +
geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue', shape = 'square') +
geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue', linetype = "dashed") +
geom_point(data = obs_resp_df, aes(x = time, y = value), color = 'orange',
shape = 'triangle') +
geom_line(data = obs_resp_df, aes(x = time, y = value), color = 'orange',
linetype = "dotdash") +
geom_point(data = obs_resp_likely_COVID_df, aes(x = time, y = value), color = 'magenta',
shape = 'triangle') +
geom_line(data = obs_resp_likely_COVID_df, aes(x = time, y = value), color = 'magenta',
linetype = "dotdash") +
theme(legend.position = "None") +
theme(axis.title.x = element_text(face = "plain"),
axis.title.y = element_text(face = "plain"))
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_Obs_COVID_hosp_cases_vs_Ribbon_Plot_C_Q1_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
alpha = 0.5), inherit.aes = FALSE) +
# geom_ribbon(data = comp_data_melt,
# aes(x = time, ymin = all_combo_median_min,
# ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
# geom_ribbon(data = comp_data_melt,
# aes(x = time, ymin = ML_low_Q,
# ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red"),
labels =
c("Simulation Median \n (MLE)")) +
xlab("Days since March 1 2020")+
ylab(expression(paste("Daily new hospitalized cases "))) +
geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
geom_point(data = obs_resp_df, aes(x = time, y = value), color = 'orange') +
geom_line(data = obs_resp_df, aes(x = time, y = value), color = 'orange') +
geom_point(data = obs_resp_likely_COVID_df, aes(x = time, y = value), color = 'magenta') +
geom_line(data = obs_resp_likely_COVID_df, aes(x = time, y = value), color = 'magenta') +
theme(legend.position = "None") +
theme(axis.title.x = element_text(face = "plain"),
axis.title.y = element_text(face = "plain"))
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/Man_Figs/Figure_5.png"))
print(p)
dev.off()## quartz_off_screen
## 2pdf(paste0("../Figures/Profiles/", model_name,
"_Model/Man_Figs/Figure_5.pdf"))
print(p)
dev.off()## quartz_off_screen
## 2png(paste0("../Figures/Profiles/", model_name,
"_Model/Sup_Figs/b_a_profile_Obs_COVID_hosp_cases_vs_Ribbon_Plot_C_Q1_over_time_simulation_from_b_a_profile__2_LL_antibody_from_antibody_b_a_profile_peak_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2Compare to observed data (b_a Profile)
Only top 2LL params via case LL (b_a Profile)
#all_combo_melt_data = melt(all_combo_data, id.vars = c("time", "combo_num"))
all_combo_data_high_Q_max = aggregate(sim_data_high_Q ~ time, params_with_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_low_Q ~ time, params_with_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_low_Q)
all_combo_data_median_max = aggregate(sim_data_median ~ time, params_with_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_median)
all_combo_data_median_min = aggregate(sim_data_median ~ time, params_with_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_median,
ML_high_Q = sim_data_high_Q,
ML_low_Q = sim_data_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)## Joining by: time## Joining by: time
true_data = dplyr::select(Observed_data, time = times,
Observed_Data = Y)
comp_data = join(comp_data, true_data)## Joining by: time## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
comp_data_melt$ML_Q_Rib_Col = "95% Simulation Quantiles \n (MLE)"
comp_data_melt$All_combo_Med_Rib_Col = "Simulation Median \n (all 2 LL combinations)"
comp_data_melt$All_combo_Q_Rib_Col = "95% Simulation Quantiles \n (all 2 LL combinations)"
fill_vec = c("Simulation Median \n (all 2 LL combinations)" = "pink", "95% Simulation Quantiles \n (MLE)" = "skyblue", "95% Simulation Quantiles \n (all 2 LL combinations)" = "red")
p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
alpha = 0.5), inherit.aes = FALSE) +
# geom_ribbon(aes(x = time, ymin = ML_low_Q,
# ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
# geom_ribbon(aes(x = time, ymin = all_combo_median_min,
# ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red","blue"),
labels =
c("Simulation Median \n (MLE)",
"Observed",
"Data Used For Fitting")) +
xlab("Days since March 1 2020")+
ylab("Observed Monthly Cases") +
theme(legend.position = "None") +
theme(axis.title.x = element_text(face = "plain", size = 24),
axis.title.y = element_text(face = "plain", size = 24)) +
theme(axis.line = element_line(colour = 'black', size = 1))+
theme(axis.ticks = element_line(colour = "black", size = 1.5))+
theme(axis.text.x = element_text(size=21)) +
theme(axis.text.y = element_text(size=21))
# xlab("")+
# ylab("")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_via_case_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2png(paste0("../Figures/Profiles/", model_name,
"_Model/Man_Figs/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_via_case_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2pdf(paste0("../Figures/Profiles/", model_name,
"_Model/Man_Figs/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_via_case_LL.pdf"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col,
alpha = 0.5), inherit.aes = FALSE) +
# geom_ribbon(aes(x = time, ymin = ML_low_Q,
# ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
# geom_ribbon(aes(x = time, ymin = all_combo_median_min,
# ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red","blue"),
labels =
c("Simulation Median \n (MLE)",
"Observed",
"Data Used For Fitting")) +
xlab("Days since March 1 2020")+
ylab("Observed Monthly Cases") +
theme(legend.position = "None") +
theme(axis.title.x = element_text(face = "plain"),
axis.title.y = element_text(face = "plain")) +
xlab("")+
ylab("") +
theme(axis.title.x = element_text(face = "plain", size = 24),
axis.title.y = element_text(face = "plain", size = 24)) +
theme(axis.line = element_line(colour = 'black', size = 1))+
theme(axis.ticks = element_line(colour = "black", size = 1.5))+
theme(axis.text.x = element_text(size=21)) +
theme(axis.text.y = element_text(size=21))
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/Man_Figs/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_via_case_LL_no_labs.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = log(all_combo_low_Q_min),
ymax = log(all_combo_high_Q_max), fill = All_combo_Q_Rib_Col, alpha = 0.5), inherit.aes = FALSE) +
# geom_ribbon(aes(x = time, ymin = log(ML_low_Q),
# ymax = log(ML_high_Q), fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
# geom_ribbon(aes(x = time, ymin = log(all_combo_median_min),
# ymax = log(all_combo_median_max), fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_line(aes(x = time, y = log(value), color = variable)) +
geom_point(aes(x = time, y = log(value), color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red","blue"),
labels =
c("Simulation Median \n (MLE)",
"Observed",
"Data Used For Fitting")) +
xlab("Days since March 1 2020")+
ylab("Observed Monthly Cases") +
theme(legend.position = "None")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_2_LL_via_case_data.png"))
print(p)
dev.off()## quartz_off_screen
## 2png(paste0("../Figures/Profiles/", model_name,
"_Model/Man_Figs/b_a_profile_log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_2_LL_via_case_data.png"))
print(p)
dev.off()## quartz_off_screen
## 2Ony top 2LL params via cases and antibody LL (b_a Profile)
#all_combo_melt_data = melt(all_combo_data, id.vars = c("time", "combo_num"))
all_combo_data_high_Q_max = aggregate(sim_data_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_low_Q)
all_combo_data_median_max = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_median)
all_combo_data_median_min = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_median,
ML_high_Q = sim_data_high_Q,
ML_low_Q = sim_data_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)## Joining by: time## Joining by: time
true_data = dplyr::select(Observed_data, time = times,
Observed_Data = Y)
comp_data = join(comp_data, true_data)## Joining by: time## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
comp_data_melt$ML_Q_Rib_Col = "95% Simulation Quantiles \n (MLE)"
comp_data_melt$All_combo_Med_Rib_Col = "Simulation Median \n (all 2 LL combinations)"
comp_data_melt$All_combo_Q_Rib_Col = "95% Simulation Quantiles \n (all 2 LL combinations)"
fill_vec = c("Simulation Median \n (all 2 LL combinations)" = "pink", "95% Simulation Quantiles \n (MLE)" = "skyblue", "95% Simulation Quantiles \n (all 2 LL combinations)" = "grey70")
p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = ML_low_Q,
ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = all_combo_median_min,
ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red","blue"),
labels =
c("Simulation Median \n (MLE)",
"Observed",
"Data Used For Fitting")) +
xlab("Days since March 1 2020")+
ylab("Observed Monthly Cases")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_b_a_profile_2_LL_antibody_from_antibody_profile_peak_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = log(all_combo_low_Q_min),
ymax = log(all_combo_high_Q_max), fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = log(ML_low_Q),
ymax = log(ML_high_Q), fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = log(all_combo_median_min),
ymax = log(all_combo_median_max), fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_line(aes(x = time, y = log(value), color = variable)) +
geom_point(aes(x = time, y = log(value), color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red","blue"),
labels =
c("Simulation Median \n (MLE)",
"Observed",
"Data Used For Fitting")) +
xlab("Days since March 1 2020")+
ylab("Observed Monthly Cases")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/b_a_profile_log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_2_LL_antibody_from_antibody_profile_peak.png"))
print(p)
dev.off()## quartz_off_screen
## 2Profile Analysis Plots
low_p_S_subset_top_2_LL_end_subset_with_antibody_LL =
top_2_LL_end_subset_with_antibody_LL %>%
filter(p_S < 0.30)
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = p_S,
y = Antibody_Mean_LL)) +
geom_point(size = 3) +
rahul_man_figure_theme +
theme_white_background +
theme(axis.title.x = element_text(face = "plain", size = 24),
axis.title.y = element_text(face = "plain", size = 24)) +
theme(axis.line = element_line(colour = 'black', size = 1))+
theme(axis.ticks = element_line(colour = "black", size = 1.5)) +
theme(axis.text.x = element_text(size=21)) +
theme(axis.text.y = element_text(size=21)) +
geom_hline(yintercept =
max(top_2_LL_end_subset_with_antibody_LL$Antibody_Mean_LL)-2,
color = 'blue', size = 1.5) +
xlab(expression(paste(
"Proportion of symptomatic cases (", p[S], ")",))) +
ylab("Likelihood with respect to serology")
# xlab("")+
# ylab("")
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"p_S_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2png(paste0("../Figures/Profiles/", model_name, "_Model/Man_Figs/",
"p_S_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = low_p_S_subset_top_2_LL_end_subset_with_antibody_LL,
aes(x = p_S,
y = Antibody_Mean_LL)) +
geom_point(size = 3) +
rahul_man_figure_theme +
theme_white_background +
theme(axis.title.x = element_text(face = "plain", size = 24),
axis.title.y = element_text(face = "plain", size = 24)) +
theme(axis.line = element_line(colour = 'black', size = 1))+
theme(axis.ticks = element_line(colour = "black", size = 1.5)) +
theme(axis.text.x = element_text(size=21)) +
theme(axis.text.y = element_text(size=21)) +
geom_hline(yintercept =
max(top_2_LL_end_subset_with_antibody_LL$Antibody_Mean_LL)-2,
color = 'blue', size = 1.5) +
xlab(expression(paste(
"Proportion of symptomatic cases (", p[S], ")",))) +
ylab("Likelihood with respect to serology")
# xlab("")+
# ylab("")
p
png(paste0("../Figures/Profiles/", model_name, "_Model/Man_Figs/",
"p_S_vs_Antibody_LL_low_p_S_subset_", model_name,
"_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = p_S,
y = Antibody_Mean_LL)) +
geom_point(size = 3) +
rahul_man_figure_theme +
theme_white_background +
theme(axis.title.x = element_text(face = "plain"),
axis.title.y = element_text(face = "plain")) +
geom_hline(yintercept =
max(top_2_LL_end_subset_with_antibody_LL$Antibody_Mean_LL)-2,
color = 'blue',
size = 1.5) +
xlab(expression(paste(
"Proportion of symptomatic cases (", p[S], ")",))) +
ylab("Likelihood with respect to serology") +
xlab("")+
ylab("") +
theme(axis.title.x = element_text(face = "plain", size = 24),
axis.title.y = element_text(face = "plain", size = 24)) +
theme(axis.line = element_line(colour = 'black', size = 1))+
theme(axis.ticks = element_line(colour = "black", size = 1.5)) +
theme(axis.text.x = element_text(size=21)) +
theme(axis.text.y = element_text(size=21))
p
png(paste0("../Figures/Profiles/", model_name, "_Model/Man_Figs/",
"p_S_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_b_a_Profile_peak_LL_no_labs.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = b_a,
y = Antibody_Mean_LL)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"b_a_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0,
y = Antibody_Mean_LL)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"R_0_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_b_a_Profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2top_2_LL_end_subset_with_antibody_LL$duration_of_symp_1 = 1/top_2_LL_end_subset_with_antibody_LL$phi_S
top_2_LL_end_subset_with_antibody_LL$duration_of_symp_2 = 1/top_2_LL_end_subset_with_antibody_LL$gamma
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
mutate(duration_of_symp = duration_of_symp_1 + duration_of_symp_2)
top_2_LL_end_subset_with_antibody_LL$gamma_total = 1/top_2_LL_end_subset_with_antibody_LL$duration_of_symp
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
mutate(Beta = R_0*gamma_total)
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL%>%
mutate(R_0_P = (Beta*b_p)/phi_U,
R_0_A = (Beta*b_a *(1-p_S))/phi_S,
R_0_S_1 = (Beta*p_S)/phi_S,
R_0_S_2 = (Beta*(1-p_H_cond_S)*p_S)/gamma)
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
mutate(R_0_NGM = R_0_P + R_0_A + R_0_S_1 + R_0_S_2)
antibody_top_2_LL_from_b_a_profile_top_2_LL = top_2_LL_end_subset_with_antibody_LL %>%
filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)
nrow(antibody_top_2_LL_from_b_a_profile_top_2_LL)## [1] 36range(antibody_top_2_LL_from_b_a_profile_top_2_LL$R_0)## [1] 2.927915 17.771088p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
aes(x = b_a,
y = R_0)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"b_a_vs_R_0_", model_name,
"_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
aes(x = b_a,
y = log(R_0))) + geom_hline(yintercept = log(3), color = 'orange') +
geom_hline(yintercept = log(4), color = 'purple') +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"b_a_vs_log_R_0_", model_name,
"_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
aes(x = b_p,
y = R_0)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"b_p_vs_R_0_", model_name,
"_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
aes(x = b_q,
y = R_0)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"b_q_vs_R_0_", model_name,
"_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2range(antibody_top_2_LL_from_b_a_profile_top_2_LL$b_q)## [1] 0.1337064 0.2401933hist(antibody_top_2_LL_from_b_a_profile_top_2_LL$R_0)
## Calculate R_0 NGM for top_2_LL of b_a profile
\[\begin{equation} R_{0_{NGM}} = \frac{\beta_P}{\phi_U} + \frac{\beta_A (1-p_S)}{\phi_S} + \frac{\beta p_S}{\phi_S} + \frac{\beta (1-p_{\text{H_cond_S}}) p_S}{\gamma} \end{equation}\]
In terms of model parameters: \[\begin{equation} R_{0_{NGM}} = \frac{\beta*b_p}{\phi_U} + \frac{\beta*b_a (1-p_S)}{\phi_S} + \frac{\beta p_S}{\phi_S} + \frac{\beta (1-p_{\text{H_cond_S}}) p_S}{\gamma} \end{equation}\]
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0_NGM)) +
geom_density() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
"_b_a_profile_density_plot_of_R_0_NGM_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0_NGM)) +
geom_histogram() +
rahul_man_figure_theme
p## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
"_b_a_Profile_histogram_of_R_0_NGM_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0_A,
y = R_0_S_1 + R_0_S_2)) +
geom_point() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
"_b_a_Profile_R_0_A_vs_R_0_S_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0,
y = R_0_NGM,
color = b_a)) +
geom_point() +
scale_color_viridis_c() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
"_b_a_Profile_R_0_vs_R_0_NGM_color_b_a_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0,
y = R_0_NGM,
color = b_p)) +
geom_point() +
scale_color_viridis_c() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
"_b_a_Profile_R_0_vs_R_0_NGM_color_b_p_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0,
y = R_0_S_1 + R_0_S_2)) +
geom_point() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_Profile/", model_name,
"_b_a_Profile_R_0_vs_R_0_S_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0_NGM,
y = Antibody_Mean_LL)) +
geom_point() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_profile/", model_name,
"_b_a_profile_R_0_NGM_vs_Likelihood_with_respect_to_antibody_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = b_a,
y = R_0_NGM)) +
geom_point() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/b_a_profile/", model_name,
"_b_a_profile_b_a_vs_R_0_NGM_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
aes(x = R_0_NGM)) +
geom_histogram() +
rahul_man_figure_theme
p## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"R_0_NGM_histogram_", model_name,
"_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
aes(x = R_0,
y = R_0_NGM,
color = b_a)) +
geom_point(size = 5) +
scale_color_viridis_c() +
rahul_man_figure_theme +
theme_white_background +
scale_x_continuous(breaks=c(seq(2,10,1), 15, 18)) +
scale_y_continuous(breaks=seq(2,5,1)) +
coord_cartesian(expand = FALSE, #turn off axis expansion (padding)
xlim = c(1.75, 18.25), ylim = c(1.75, 5.25)) #manually set limits
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"R_0_vs_R_0_NGM_color_by_b_a", model_name,
"_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
aes(x = R_0,
y = R_0_NGM,
color = b_p)) +
geom_point(size = 5) +
scale_color_viridis_c() +
rahul_man_figure_theme +
theme_white_background +
scale_x_continuous(breaks=c(seq(2,10,1), 15, 18)) +
scale_y_continuous(breaks=seq(2,5,1)) +
coord_cartesian(expand = FALSE, #turn off axis expansion (padding)
xlim = c(1.75, 18.25), ylim = c(1.75, 5.25)) #manually set limits
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"R_0_vs_R_0_NGM_color_by_b_p", model_name,
"_model_top_2_antibody_LL_from_b_a_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_b_a_profile_top_2_LL,
aes(x = R_0,
y = R_0_NGM,
color = b_p)) +
geom_point(size = 5) +
scale_color_viridis_c() +
rahul_man_figure_theme +
theme_white_background +
scale_x_continuous(breaks=c(seq(2,10,1), 15, 18)) +
scale_y_continuous(breaks=seq(2,5,1)) +
coord_cartesian(expand = FALSE, #turn off axis expansion (padding)
xlim = c(1.75, 9), ylim = c(1.75, 5.25)) #manually set limits
p
png(paste0("../Figures/Profiles/", model_name, "_Model/Sup_Figs/",
"R_0_vs_R_0_NGM_color_by_b_p", model_name,
"_model_top_2_antibody_LL_from_b_a_profile_peak_LL_no_outlier.png"))
print(p)
dev.off()## quartz_off_screen
## 2Surface plots
antibody_top_2_LL_from_b_a_profile_top_2_LL_no_outlier =
antibody_top_2_LL_from_b_a_profile_top_2_LL %>%
filter(R_0 <15)
save(antibody_top_2_LL_from_b_a_profile_top_2_LL_no_outlier,
file = paste0("../Generated_Data/Profiles/", model_name, "_Model/top_2_LL_data/b_a_profile_antibody_surface_plot_data.RData"))
save(antibody_top_2_LL_from_b_a_profile_top_2_LL,
file = paste0("../Generated_Data/Profiles/", model_name, "_Model/top_2_LL_data/b_a_profile_antibody_surface_plot_data_with_outlier.RData"))
library(plotly)## Warning: package 'plotly' was built under R version 3.5.2##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following objects are masked from 'package:plyr':
##
## arrange, mutate, rename, summarise## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layout# if (!require("processx")) install.packages("processx")
fig <- plot_ly(antibody_top_2_LL_from_b_a_profile_top_2_LL_no_outlier,
x = ~b_a, y = ~b_p, z = ~R_0, color = ~b_a)
fig <- fig %>% add_markers()
fig <- fig %>% layout(scene = list(xaxis = list(title = ' b_a'),
yaxis = list(title = ' b_p'),
zaxis = list(title = 'R_0 ')))
fig# orca(fig, "surface-plot.svg")source("Sim_G_w_y_scaling_profile_peak_Model_N_12.R")Code for simulations
knitr::read_chunk('Sim_G_w_y_scaling_profile_peak_Model_N_12.R')#rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
#model_name = as.character(args[1])
#print(model_name)
profile_var = "G_w_y_scaling"
model_name = "N_12"
#param_index = 1
#i = 1
#Load Observed NYC case data
Observed_data = read.csv(paste0(
"../Generated_Data/observed_data_",
model_name, ".csv"))
head(Observed_data)
### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")
## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14
#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")
## Load NYC covariate data
covariate_df = read.csv(file =
paste0("../Generated_Data/covariate_data_",
model_name, ".csv"))
### Create covariate table
covar=covariate_table(
time=covariate_df$times,
L_advanced_2_days=covariate_df$L_advanced_2_days,
F_w_y = covariate_df$F_w_y,
L_orig = covariate_df$L_orig,
w = covariate_df$Week,
y = covariate_df$Year,
times="time"
)
param_index = 1
head(profile_peak_data_G_w_y_scaling)
##load(param_grid)
load(file = paste0(
"../Generated_Data/Profiles/", model_name,
"_Model/",
profile_var,
"_Profile/top_2_LL_of_",
profile_var,
"_profile.RData"))
profile_peak_data = profile_peak_data_G_w_y_scaling
midway_max_jobs = 1
group_size = nrow(profile_peak_data) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_sim_runs_per_start = 1
top_2_LL_end_data_subset_act = profile_peak_data[start_index:end_index,]
top_2_LL_end_data_subset = top_2_LL_end_data_subset_act[rep(
seq_len(nrow(top_2_LL_end_data_subset_act)),
each = Num_sim_runs_per_start),]
## Load Antibdoy data
nyc_antibdoy_df = read.csv("../Generated_Data/antibody_data_from_nyc_study_with_RS_calc_CI.csv")
head(nyc_antibdoy_df)
# Top 2 LL
top_2_LL_end_subset_with_antibody_LL =
data.frame(matrix(nrow = 0,
ncol = ncol(top_2_LL_end_data_subset) + 5))
colnames(top_2_LL_end_subset_with_antibody_LL) =
c(colnames(top_2_LL_end_data_subset), "Antibody_Mean_LL", "Antibody_LL_SE","Median_Herd_Immunity",
"sim_subset_index", "combo_num")
all_combo_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_data) = c("time", "sim_data_median ", "sim_data_low_Q",
"sim_data_high_Q","combo_num", "sim_subset_index")
all_combo_S_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_S_data) = c("time", "sim_data_S_over_N_median ", "sim_data_S_over_N_low_Q",
"sim_data_S_over_N_high_Q","combo_num", "sim_subset_index")
all_combo_C_Q1_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_C_Q1_data) = c("time", "sim_data_C_Q1_median ", "sim_data_C_Q1_low_Q",
"sim_data_C_Q1_high_Q","combo_num", "sim_subset_index")
all_combo_R_data = data.frame(matrix(nrow = 0, ncol = 6))
colnames(all_combo_R_data) = c("time", "sim_data_R_over_N_median ", "sim_data_R_over_N_low_Q",
"sim_data_R_over_N_high_Q","combo_num", "sim_subset_index")
for(combo_index in seq(1:nrow(top_2_LL_end_data_subset))){
#print(combo_index)
combo_params = top_2_LL_end_data_subset[combo_index,]
combo_params = dplyr::select(combo_params, -one_of(
"msg", "iter_num", "param_index","loglik", "nfail", "trace_num", "loglist.se"))
sim_data_sample_param = simulate(nsim = 100,
seed = 12345,
times = Observed_data$times,
t0 = t0,
rprocess = pomp::euler(rproc,delta.t = 1),
params = combo_params,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
covar = covar,
partrans = par_trans,
format = "data.frame")
#head(sim_data)
sim_data_sample_param_median_Y = aggregate(Y ~ time, sim_data_sample_param, median)
sim_data_sample_param_quant = aggregate(Y ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
sim_data_sample_param_quant$Y = as.data.frame(sim_data_sample_param_quant$Y)
colnames(sim_data_sample_param_quant$Y) = c("Q2.5", "Q97.5")
combo_num = rep(combo_index, nrow(sim_data_sample_param_median_Y))
sim_subset_index = rep(param_index, nrow(sim_data_sample_param_median_Y))
single_combo_data = data.frame(time = sim_data_sample_param_median_Y$time,
sim_data_median = sim_data_sample_param_median_Y$Y,
sim_data_low_Q = sim_data_sample_param_quant$Y$Q2.5,
sim_data_high_Q = sim_data_sample_param_quant$Y$Q97.5,
combo_num = combo_num,
sim_subset_index = sim_subset_index)
all_combo_data = rbind(all_combo_data, single_combo_data)
sim_data_sample_param$S_over_N = sim_data_sample_param$S/sim_data_sample_param$N
sim_data_S_over_N_median = aggregate(S_over_N ~ time, sim_data_sample_param, median)
sim_data_sample_param_S_over_N_quant = aggregate(S_over_N ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
sim_data_sample_param_S_over_N_quant$S_over_N = as.data.frame(sim_data_sample_param_S_over_N_quant$S_over_N)
colnames(sim_data_sample_param_S_over_N_quant$S_over_N) = c("Q2.5", "Q97.5")
single_combo_S_data = data.frame(time = sim_data_sample_param_median_Y$time,
sim_data_S_over_N_median = sim_data_S_over_N_median$S_over_N,
sim_data_S_over_N_low_Q = sim_data_sample_param_S_over_N_quant$S_over_N$Q2.5,
sim_data_S_over_N_high_Q = sim_data_sample_param_S_over_N_quant$S_over_N$Q97.5,
combo_num = combo_num,
sim_subset_index = sim_subset_index)
all_combo_S_data = rbind(all_combo_S_data, single_combo_S_data)
sim_data_C_Q1_median = aggregate(C_Q1 ~ time, sim_data_sample_param, median)
sim_data_sample_param_C_Q1_quant = aggregate(C_Q1 ~ time, sim_data_sample_param, quantile, probs = c(0.025, 0.975))
sim_data_sample_param_C_Q1_quant$C_Q1 = as.data.frame(sim_data_sample_param_C_Q1_quant$C_Q1)
colnames(sim_data_sample_param_C_Q1_quant$C_Q1) = c("Q2.5", "Q97.5")
single_combo_C_Q1_data = data.frame(time = sim_data_sample_param_median_Y$time,
sim_data_C_Q1_median = sim_data_C_Q1_median$C_Q1,
sim_data_C_Q1_low_Q = sim_data_sample_param_C_Q1_quant$C_Q1$Q2.5,
sim_data_C_Q1_high_Q = sim_data_sample_param_C_Q1_quant$C_Q1$Q97.5,
combo_num = combo_num,
sim_subset_index = sim_subset_index)
all_combo_C_Q1_data = rbind(all_combo_C_Q1_data, single_combo_C_Q1_data)
rel_columns = sim_data_sample_param %>%
dplyr::select(R_A, R_F, R_H, time, .id, N)
sim_data_sample_param_modified = rel_columns %>%
mutate(R_sum = R_A + R_F + R_H)
sim_data_sample_param_modified$R_over_N = sim_data_sample_param_modified$R_sum/sim_data_sample_param_modified$N
sim_data_R_over_N_median = aggregate(R_over_N ~ time, sim_data_sample_param_modified, median)
sim_data_sample_param_R_over_N_quant = aggregate(R_over_N ~ time, sim_data_sample_param_modified,
quantile, probs = c(0.025, 0.975))
sim_data_sample_param_R_over_N_quant$R_over_N = as.data.frame(sim_data_sample_param_R_over_N_quant$R_over_N)
colnames(sim_data_sample_param_R_over_N_quant$R_over_N) = c("Q2.5", "Q97.5")
single_combo_R_data = data.frame(
time = sim_data_sample_param_median_Y$time,
sim_data_R_over_N_median = sim_data_R_over_N_median$R_over_N,
sim_data_R_over_N_low_Q = sim_data_sample_param_R_over_N_quant$R_over_N$Q2.5,
sim_data_R_over_N_high_Q = sim_data_sample_param_R_over_N_quant$R_over_N$Q97.5,
combo_num = combo_num,
sim_subset_index = sim_subset_index)
all_combo_R_data = rbind(all_combo_R_data, single_combo_R_data)
nyc_antibody_df = nyc_antibdoy_df %>%
mutate(time = times)
sim_data_sample_param_for_antibody_comp = sim_data_sample_param_modified %>%
dplyr::select(time, R_over_N, sim_id = .id)
sim_data_sample_param_with_antibody_df = inner_join(
sim_data_sample_param_for_antibody_comp,
nyc_antibody_df,
by = c("time"))
### Exclude first antibody observation on March 1st-The simulation just started
#on that date.
sim_data_sample_param_with_antibody_df = sim_data_sample_param_with_antibody_df %>%
filter(time > 0)
## Calculate LL
sim_data_sample_param_with_antibody_df = sim_data_sample_param_with_antibody_df %>%
mutate(Antibody_LL = dbinom(x = Num_Positive, p = R_over_N, size = Num_Sampled,
log = TRUE))
antibody_LL_per_sim_run = sim_data_sample_param_with_antibody_df %>%
group_by(sim_id) %>%
summarize(LL_per_run = sum(Antibody_LL)) %>%
as.data.frame()
total_antibody_LL_for_combination = logmeanexp(antibody_LL_per_sim_run$LL_per_run,
se = TRUE)
single_param_with_antibody_LL = top_2_LL_end_data_subset[combo_index,]
single_param_with_antibody_LL$Antibody_Mean_LL = total_antibody_LL_for_combination[[1]]
single_param_with_antibody_LL$Antibody_LL_SE = total_antibody_LL_for_combination[[2]]
single_param_with_antibody_LL$Median_Herd_Immunity =
sim_data_R_over_N_median$R_over_N[nrow(sim_data_R_over_N_median)]
single_param_with_antibody_LL$combo_num = combo_index
single_param_with_antibody_LL$sim_subset_index = param_index
top_2_LL_end_subset_with_antibody_LL = rbind(top_2_LL_end_subset_with_antibody_LL,
single_param_with_antibody_LL)
}
save(all_combo_data,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_sim_cases_data.RData"))
save(all_combo_S_data,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_sim_S_over_N_data.RData"
))
save(all_combo_R_data,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_sim_R_over_N_data.RData"
))
save(all_combo_C_Q1_data,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_sim_C_Q_1_data.RData"))
save(top_2_LL_end_subset_with_antibody_LL,
file = paste0(
"../Generated_Data/Profiles/",
model_name, "_Model/", profile_var, "_Profile/", profile_var,
"_profile_top_2_LL_all_params_with_antibody_LL.RData"))R over N for top parameter combinations within 2LL when fit to antibody and case data (G_w_y_scaling Profile)
params_with_data = join(all_combo_R_data,
top_2_LL_end_subset_with_antibody_LL)## Joining by: combo_num, sim_subset_indexparams_with_data = join(params_with_data,
all_combo_S_data)## Joining by: time, combo_num, sim_subset_indexparams_with_data = join(params_with_data,
all_combo_C_Q1_data)## Joining by: time, combo_num, sim_subset_indexparams_with_data = join(params_with_data,
all_combo_data)## Joining by: time, combo_num, sim_subset_indexantibody_top_2_LL_params_and_sim_data = params_with_data %>%
filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)
#head(params_with_data)
all_combo_data_high_Q_max = aggregate(sim_data_R_over_N_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_R_over_N_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_R_over_N_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_R_over_N_low_Q)
all_combo_data_median_max = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_R_over_N_median)
all_combo_data_median_min = aggregate(sim_data_R_over_N_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_R_over_N_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_R_over_N_median,
ML_high_Q = sim_data_R_over_N_high_Q,
ML_low_Q = sim_data_R_over_N_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: timecomp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_max)## Joining by: timecomp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE for antibody data)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n (all 2 LL combinations (for antibody data))"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations (for antibody data))"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab
fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)
p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_median_min,
ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = ML_low_Q,
ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red"),
labels =
c("Simulation Median \n (MLE)")) +
xlab("Days since March 1 2020")+
ylab(expression(paste(frac(R,N)))) +
geom_ribbon(data = nyc_antibody_df,aes(x = times, ymin = lower_CI,
ymax = upper_CI),
fill = 'blue',
alpha = 0.5) +
geom_point(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue') +
geom_line(data = nyc_antibody_df,
aes(x = times, y = Prop_Positive), color = 'blue')
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/G_w_y_scaling_profile_Observed_Antibody_data_vs_Ribbon_Plot_R_over_N_over_time_simulation_from_G_w_y_scaling_profile__2_LL_antibody_from_antibody_G_w_y_scaling_profile_peak_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2C_Q1 (G_w_y_scaling Profile)
all_combo_data_high_Q_max = aggregate(sim_data_C_Q1_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_C_Q1_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_C_Q1_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_C_Q1_low_Q)
all_combo_data_median_max = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_C_Q1_median)
all_combo_data_median_min = aggregate(sim_data_C_Q1_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_C_Q1_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_C_Q1_median,
ML_high_Q = sim_data_C_Q1_high_Q,
ML_low_Q = sim_data_C_Q1_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: timecomp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_min)## Joining by: timecomp_data = join(comp_data, all_combo_data_median_max)## Joining by: timecomp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
ML_Q_Rib_Col_lab = "95% Simulation Quantiles \n (MLE)"
All_combo_Med_Rib_Col_lab = "Simulation Median \n (all 2 LL combinations)"
All_combo_Q_Rib_Col_lab = "95% Simulation Quantiles \n (all 2 LL combinations)"
comp_data_melt$ML_Q_Rib_Col = ML_Q_Rib_Col_lab
comp_data_melt$All_combo_Med_Rib_Col = All_combo_Med_Rib_Col_lab
comp_data_melt$All_combo_Q_Rib_Col = All_combo_Q_Rib_Col_lab
fill_vec = c("pink", "skyblue", "grey70")
names(fill_vec) = c(All_combo_Med_Rib_Col_lab, ML_Q_Rib_Col_lab, All_combo_Q_Rib_Col_lab)
hosp_comp_df = read.csv("../Generated_Data/hosp_comp_df.csv")
obs_hosp_df = hosp_comp_df %>%
filter(variable == "HOSPITALIZED_COUNT") %>%
dplyr::select(-Date, -Day_of_Week, time = times)
p = ggplot() +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = all_combo_median_min,
ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(data = comp_data_melt,
aes(x = time, ymin = ML_low_Q,
ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_line(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
geom_point(data = comp_data_melt,
aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red"),
labels =
c("Simulation Median \n (MLE)")) +
xlab("Days since March 1 2020")+
ylab(expression(paste(C_Q1))) +
geom_point(data = obs_hosp_df, aes(x = time, y = value), color = 'blue') +
geom_line(data = obs_hosp_df, aes(x = time, y = value), color = 'blue')
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/G_w_y_scaling_profile_Obs_COVID_hosp_cases_vs_Ribbon_Plot_C_Q1_over_time_simulation_from_G_w_y_scaling_profile__2_LL_antibody_from_antibody_G_w_y_scaling_profile_peak_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2Compare to observed data (G_w_y_scaling Profile)
#all_combo_melt_data = melt(all_combo_data, id.vars = c("time", "combo_num"))
all_combo_data_high_Q_max = aggregate(sim_data_high_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_high_Q_max = dplyr::select(all_combo_data_high_Q_max,
time = time,
all_combo_high_Q_max = sim_data_high_Q)
all_combo_data_low_Q_min = aggregate(sim_data_low_Q ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_low_Q_min = dplyr::select(all_combo_data_low_Q_min,
time = time,
all_combo_low_Q_min = sim_data_low_Q)
all_combo_data_median_max = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = max)
all_combo_data_median_max = dplyr::select(all_combo_data_median_max,
time = time,
all_combo_median_max = sim_data_median)
all_combo_data_median_min = aggregate(sim_data_median ~ time, antibody_top_2_LL_params_and_sim_data,
FUN = min)
all_combo_data_median_min = dplyr::select(all_combo_data_median_min,
time = time,
all_combo_median_min = sim_data_median)
ML_output = antibody_top_2_LL_params_and_sim_data %>%
filter(Antibody_Mean_LL == max(Antibody_Mean_LL))
ML_output = dplyr::select(ML_output, time = time,
ML_median = sim_data_median,
ML_high_Q = sim_data_high_Q,
ML_low_Q = sim_data_low_Q)
comp_data = join(ML_output, all_combo_data_high_Q_max)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_low_Q_min)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_median_min)## Joining by: time## Joining by: time
comp_data = join(comp_data, all_combo_data_median_max)## Joining by: time## Joining by: time
true_data = dplyr::select(Observed_data, time = times,
Observed_Data = Y)
comp_data = join(comp_data, true_data)## Joining by: time## Joining by: time
comp_data_melt = melt(comp_data, id.vars = c("time",
"ML_high_Q", "ML_low_Q",
"all_combo_high_Q_max",
"all_combo_low_Q_min",
"all_combo_median_min",
"all_combo_median_max"))
comp_data_melt$ML_Q_Rib_Col = "95% Simulation Quantiles \n (MLE)"
comp_data_melt$All_combo_Med_Rib_Col = "Simulation Median \n (all 2 LL combinations)"
comp_data_melt$All_combo_Q_Rib_Col = "95% Simulation Quantiles \n (all 2 LL combinations)"
fill_vec = c("Simulation Median \n (all 2 LL combinations)" = "pink", "95% Simulation Quantiles \n (MLE)" = "skyblue", "95% Simulation Quantiles \n (all 2 LL combinations)" = "grey70")
p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = all_combo_low_Q_min,
ymax = all_combo_high_Q_max, fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = ML_low_Q,
ymax = ML_high_Q, fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = all_combo_median_min,
ymax = all_combo_median_max, fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_line(aes(x = time, y = value, color = variable)) +
geom_point(aes(x = time, y = value, color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red","blue"),
labels =
c("Simulation Median \n (MLE)",
"Observed",
"Data Used For Fitting")) +
xlab("Days since March 1 2020")+
ylab("Observed Monthly Cases")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/G_w_y_scaling_profile_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_G_w_y_scaling_profile_2_LL_antibody_from_antibody_profile_peak_params.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = comp_data_melt) +
geom_ribbon(aes(x = time, ymin = log(all_combo_low_Q_min),
ymax = log(all_combo_high_Q_max), fill = All_combo_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = log(ML_low_Q),
ymax = log(ML_high_Q), fill = ML_Q_Rib_Col), inherit.aes = FALSE) +
geom_ribbon(aes(x = time, ymin = log(all_combo_median_min),
ymax = log(all_combo_median_max), fill = All_combo_Med_Rib_Col), inherit.aes = FALSE) +
geom_line(aes(x = time, y = log(value), color = variable)) +
geom_point(aes(x = time, y = log(value), color = variable)) +
rahul_theme +
theme(legend.text = element_text(size = 12,
face = "bold",
color = "black")) +
theme_white_background +
scale_fill_manual(name = "Ribbon Legend", values = fill_vec) +
scale_color_manual(name = "Color Legend", values = c("red","blue"),
labels =
c("Simulation Median \n (MLE)",
"Observed",
"Data Used For Fitting")) +
xlab("Days since March 1 2020")+
ylab("Observed Monthly Cases")
p
png(paste0("../Figures/Profiles/", model_name,
"_Model/top_2_LL_sim_plots/top_2_LL_via_antibody_comp_plots/G_w_y_scaling_profile_log_Obs_daily_COVID_cases_vs_Ribbon_Plot_simulated_cases_over_time_simulation_from_2_LL_antibody_from_antibody_profile_peak.png"))
print(p)
dev.off()## quartz_off_screen
## 2Profile analysis plots
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = p_S,
y = Antibody_Mean_LL)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"p_S_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_G_w_y_scaling_Profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = b_a,
y = Antibody_Mean_LL)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"b_a_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_G_w_y_scaling_Profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0,
y = Antibody_Mean_LL)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"R_0_vs_Antibody_LL_", model_name,
"_model_antibody_LL_from_G_w_y_scaling_Profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2head(top_2_LL_end_subset_with_antibody_LL)## G_w_y_scaling M_0 V_0 K_0 R_0 b_q b_a b_p p_S
## 1 0.1137931 5 13 14 5.723926 0.1507524 0.7854870 0 0.09086144
## 2 0.1137931 5 13 14 4.708381 0.1485728 0.9222754 0 0.11202716
## 3 0.1251724 5 13 14 9.325590 0.1410724 0.2478865 0 0.20058425
## 4 0.1251724 5 13 14 7.305199 0.1594458 0.5414109 0 0.09463406
## 5 0.1251724 5 13 14 11.298709 0.1360877 0.2015189 0 0.18165551
## 6 0.1251724 5 13 14 5.893892 0.1325272 0.6100393 0 0.21542419
## p_H_cond_S phi_E phi_U phi_S h_V gamma N_0 E_0 z_0 C_0
## 1 0.10470967 1.09 1.09 0.2 0.125 202.92645 8e+06 69259.55 25317.20 0
## 2 0.10403656 1.09 1.09 0.2 0.125 181.58790 8e+06 71920.34 17252.26 0
## 3 0.08133696 1.09 1.09 0.2 0.125 302.75063 8e+06 44516.55 12332.46 0
## 4 0.08674280 1.09 1.09 0.2 0.125 119.69524 8e+06 73408.35 29639.12 0
## 5 0.08282378 1.09 1.09 0.2 0.125 113.87758 8e+06 35780.51 17105.31 0
## 6 0.09127855 1.09 1.09 0.2 0.125 96.51711 8e+06 36215.94 10747.12 0
## social_distancing_start_time quarantine_start_time PCR_sens sigma_M
## 1 17 22 0.9 0.2771416
## 2 17 22 0.9 0.2764743
## 3 17 22 0.9 0.2748670
## 4 17 22 0.9 0.2732558
## 5 17 22 0.9 0.2727828
## 6 17 22 0.9 0.2772539
## beta_w_3 beta_w_2 beta_w_1 beta_w_0 g_0 g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 2 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 3 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 4 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 5 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## 6 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## msg iter_num param_index loglik nfail trace_num loglist.se
## 1 mif1 1 171 -628.1586 NA NA 0.010046013
## 2 mif1 2 183 -628.0499 NA NA 0.006061666
## 3 mif1 1 185 -627.2937 NA NA 0.008435769
## 4 mif1 1 188 -626.2718 NA NA 0.010147800
## 5 mif1 1 189 -627.9499 NA NA 0.010069333
## 6 mif1 2 189 -626.6486 NA NA 0.009115353
## Antibody_Mean_LL Antibody_LL_SE Median_Herd_Immunity combo_num
## 1 -43.99074 0.02136674 0.3302930 1
## 2 -31.45546 0.01372541 0.2738905 2
## 3 -30.77820 0.01511641 0.1465016 3
## 4 -43.88899 0.01918563 0.3219798 4
## 5 -28.22636 0.01248400 0.1592594 5
## 6 -33.70748 0.01503283 0.1393224 6
## sim_subset_index
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1top_2_LL_end_subset_with_antibody_LL$duration_of_symp_1 = 1/top_2_LL_end_subset_with_antibody_LL$phi_S
top_2_LL_end_subset_with_antibody_LL$duration_of_symp_2 = 1/top_2_LL_end_subset_with_antibody_LL$gamma
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
mutate(duration_of_symp = duration_of_symp_1 + duration_of_symp_2)
top_2_LL_end_subset_with_antibody_LL$gamma_total = 1/top_2_LL_end_subset_with_antibody_LL$duration_of_symp
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
mutate(Beta = R_0*gamma_total)
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL%>%
mutate(R_0_P = (Beta*b_p)/phi_U,
R_0_A = (Beta*b_a *(1-p_S))/phi_S,
R_0_S_1 = (Beta*p_S)/phi_S,
R_0_S_2 = (Beta*(1-p_H_cond_S)*p_S)/gamma)
top_2_LL_end_subset_with_antibody_LL = top_2_LL_end_subset_with_antibody_LL %>%
mutate(R_0_NGM = R_0_P + R_0_A + R_0_S_1 + R_0_S_2)
p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0_NGM)) +
geom_histogram() + rahul_man_figure_theme
p## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
"_G_w_y_scaling_profile_R_0_NGM_histogram_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0,
y = R_0_NGM,
color = b_a)) +
geom_point() +
scale_color_viridis_c() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
"_G_w_y_scaling_profile_R_0_vs_R_0_NGM_color_b_a_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0,
y = R_0_NGM,
color = b_p)) +
geom_point() +
scale_color_viridis_c() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
"_G_w_y_scaling_profile_R_0_vs_R_0_NGM_color_b_p_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = R_0,
y = R_0_NGM,
color = G_w_y_scaling)) +
geom_point() +
scale_color_viridis_c() +
rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
"_G_w_y_scaling_profile_R_0_vs_R_0_NGM_color_G_w_y_scaling_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = top_2_LL_end_subset_with_antibody_LL,
aes(x = G_w_y_scaling,
y = R_0_NGM)) +
geom_point() + rahul_man_figure_theme
p
png(file = paste0("../Figures/Profiles/", model_name, "_Model/G_w_y_scaling_profile/", model_name,
"_G_w_y_scaling_profile_G_w_y_scaling_vs_R_0_NGM_histogram_for_all_parameter_combinations_within_2LL_of_profile_MLE_fit_to_cases.png"))
print(p)
dev.off()## quartz_off_screen
## 2antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL =
top_2_LL_end_subset_with_antibody_LL %>%
filter(Antibody_Mean_LL > max(Antibody_Mean_LL)-2)
nrow(antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL)## [1] 1range(antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL$R_0)## [1] 6.252792 6.252792antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL## G_w_y_scaling M_0 V_0 K_0 R_0 b_q b_a b_p p_S
## 1 0.1365517 5 13 14 6.252792 0.1472358 0.5492081 0 0.1620639
## p_H_cond_S phi_E phi_U phi_S h_V gamma N_0 E_0 z_0 C_0
## 1 0.07649814 1.09 1.09 0.2 0.125 582.3939 8e+06 43192.67 21552.95 0
## social_distancing_start_time quarantine_start_time PCR_sens sigma_M
## 1 17 22 0.9 0.2724676
## beta_w_3 beta_w_2 beta_w_1 beta_w_0 g_0 g_F sigma_epsilon
## 1 0.01215073 0.9810086 -37.23481 229.4094 1183.3 0.1162005 109.1121
## msg iter_num param_index loglik nfail trace_num loglist.se
## 1 mif1 1 217 -627.2268 NA NA 0.01303892
## Antibody_Mean_LL Antibody_LL_SE Median_Herd_Immunity combo_num
## 1 -25.1653 0.003145945 0.1864272 15
## sim_subset_index duration_of_symp_1 duration_of_symp_2 duration_of_symp
## 1 1 5 0.001717051 5.001717
## gamma_total Beta R_0_P R_0_A R_0_S_1 R_0_S_2 R_0_NGM
## 1 0.1999313 1.250129 0 2.876555 1.013004 0.0003212641 3.88988p = ggplot(data = antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL,
aes(x = b_a,
y = R_0)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"b_a_vs_R_0_", model_name,
"_model_top_2_antibody_LL_from_G_w_y_scaling_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL,
aes(x = b_a,
y = log(R_0))) + geom_hline(yintercept = log(3), color = 'orange') +
geom_hline(yintercept = log(4), color = 'purple') +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"b_a_vs_log_R_0_", model_name,
"_model_top_2_antibody_LL_from_G_w_y_scaling_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL,
aes(x = b_p,
y = R_0)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"b_p_vs_R_0_", model_name,
"_model_top_2_antibody_LL_from_G_w_y_scaling_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2p = ggplot(data = antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL,
aes(x = b_q,
y = R_0)) +
geom_point() +
rahul_man_figure_theme
p
png(paste0("../Figures/Profiles/", model_name, "_Model/top_2_LL_sim_plots/",
"top_2_LL_via_antibody_comp_plots/",
"b_q_vs_R_0_", model_name,
"_model_top_2_antibody_LL_from_G_w_y_scaling_profile_peak_LL.png"))
print(p)
dev.off()## quartz_off_screen
## 2antibody_top_2_LL_from_G_w_y_scaling_profile_top_2_LL$R_0_NGM## [1] 3.88988Code for validation analysis using simulated data
Code to run MIF for initial grid search (SEIAR) for big b_a simulation trajectory
knitr::read_chunk('MIF_run_Model_N_12_sim_data_big_b_a.R')# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12_sim_data_big_b_a.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12 fit to simulated trajectory from
## big b_a parameter combination.
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
model_name = as.character(args[1])
print(model_name)
#model_name = "N_12"
#param_index = 1
#i = 1
#Load Simulated NYC data from big b_a parameter combination
#that will be used for fitting
big_b_a_single_traj_data = read.csv(
"../Generated_Data/Representative_Simulations/big_b_a_single_sim_traj_data.csv")
head(big_b_a_single_traj_data)
### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")
## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14
#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")
## Load NYC covariate data
covariate_df = read.csv(file =
paste0("../Generated_Data/covariate_data_",
model_name, ".csv"))
### Create covariate table
covar=covariate_table(
time=covariate_df$times,
L_advanced_2_days=covariate_df$L_advanced_2_days,
F_w_y = covariate_df$F_w_y,
L_orig = covariate_df$L_orig,
w = covariate_df$Week,
y = covariate_df$Year,
times="time"
)
require(foreach)
require(doParallel)
require(deSolve)
#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
cl <- makeCluster(no_cores, outfile="")
registerDoParallel(cl)
param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)
##load(param_grid)
pd = read.csv(
file = paste0(
"../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/",
model_name,
"_param_grid.csv"
),
header = TRUE
)
head(pd)
midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
seq_len(nrow(param_data_subset_act)),
each = Num_mif_runs_per_start),]
rw_sd_list_default = rw.sd(
M_0 = 0,
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_U = 0,
b_p = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
rw.sd = rw_sd_list_default
detail_log = FALSE
if (detail_log == TRUE) {
detailed_log_file_name = paste0(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
profile_var,
"_Profile/Detailed_Log/log_file_subset_",
param_index,
".txt"
)
write(file = detailed_log_file_name,
paste0("Log generated on ", Sys.time(), " \n"),
append = FALSE)
}
mif_single_subset_data <-
foreach(
i = 1:nrow(param_data_subset),
.combine = rbind,
.packages = c('pomp', 'dplyr'),
.export = c(
"rproc",
"rmeas",
"dmeas",
"init",
"paramnames",
"statenames",
"obsnames",
"param_data_subset",
"par_trans",
"acumvarnames",
"covar"
)
) %dopar%
{
tryCatch({
print(param_data_subset[i,])
print("iter_num")
print(i)
print("param_index")
print(param_index)
params = param_data_subset[i,]
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
seed <- round(runif(1, min = 1, max = 2 ^ 30))
#seed = 565013131
mif_single_param_output <- mif2(
data = big_b_a_single_traj_data,
times = big_b_a_single_traj_data$times,
t0 = t0,
seed = seed,
rproc = pomp::euler(rproc, delta.t = 1),
params = params,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
tol = 0,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
start = params,
Np = 10000,
Nmif = 50,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd
)
first_trace_df = mif_single_param_output@traces %>%
as.data.frame()
first_trace_df$trace_num = seq(1:nrow(first_trace_df))
# trace_df_ll = trace_df %>%
# dplyr::select(loglik, nfail)
# trace_df_no_ll = trace_df %>%
# dplyr::select(-loglik, -nfail)
# trace_df = trace_df_no_ll %>%
# mutate(nfail = trace_df_ll$nfail,
# loglik = trace_df_ll$loglik)
first_trace_df$loglik
first_trace_df$loglist.se = NA
first_trace_df$iter_num = i
first_trace_df$param_index = param_index
first_trace_df$msg = "first_trace"
mif_second_round = mif_single_param_output %>%
mif2(Nmif = 50)
second_trace_df = mif_second_round@traces %>%
as.data.frame()
second_trace_df$trace_num = seq(1:nrow(second_trace_df))
second_trace_df$loglik
second_trace_df$loglist.se = NA
second_trace_df$iter_num = i
second_trace_df$param_index = param_index
second_trace_df$msg = "second_trace"
ll <- tryCatch(
replicate(n = 10, logLik(
pfilter(
data = big_b_a_single_traj_data,
times = big_b_a_single_traj_data$times,
t0 = t0,
rprocess = pomp::euler(rproc, delta.t = 1),
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
format = "data.frame",
Np = 50000,
params = coef(mif_second_round)
)
)),
error = function(e)
e
)
fin = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
if (is(ll, "error")) {
} else{
ll_with_se = logmeanexp(ll, se = TRUE)
if (detail_log == TRUE) {
log_str = paste0(log_str,
"pfilter_warnings: \n ",
warnings(),
" \n Done with warnings \n")
}
}
if (is.na(ll_with_se[[1]])) {
} else{
fin$loglik = ll_with_se[[1]]
fin$loglist.se = ll_with_se[[2]]
}
fin$iter_num = i
fin$param_index = param_index
fin$msg = "mif1"
start_and_trace = bind_rows(start, first_trace_df)
start_and_trace = bind_rows(start_and_trace, second_trace_df)
bind_rows(start_and_trace, fin)
},
error = function (e) {
warning("Inside error function")
print("iter_num")
print(i)
print("param_index")
print(param_index)
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
start$loglik = NA
start$nfail = NA
start$trace_num = NA
start$loglist.se = NA
fin = start
fin$msg = conditionMessage(e)
full_join(start, fin, by = names(start))
})
} -> res
output_name = paste(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
"Sim_Data_Big_b_a_param_Grid_Search_MIF_run_1/",
model_name,
"_Sim_Data_Big_b_a_param_Grid_Search_MIF_run_1_subset_",
param_index,
".RData",
sep = ""
)
if (detail_log == TRUE) {
write(file = detailed_log_file_name, log_output, append = TRUE)
}
save(res, file = output_name)
res
proc.time() - ptmCode to run MIF for initial grid search (SEIAR) for small b_a simulation trajectory
knitr::read_chunk('MIF_run_Model_N_12_sim_data_small_b_a.R')# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12_sim_data_small_b_a.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12 fit to simulated trajectory from
## small b_a parameter combination.
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
model_name = as.character(args[1])
print(model_name)
#model_name = "N_12"
#param_index = 1
#i = 1
#Load Simulated NYC data from small b_a parameter combination
#that will be used for fitting
small_b_a_single_traj_data = read.csv(
"../Generated_Data/Representative_Simulations/small_b_a_single_sim_traj_data.csv")
head(small_b_a_single_traj_data)
### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")
## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14
#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")
## Load NYC covariate data
covariate_df = read.csv(file =
paste0("../Generated_Data/covariate_data_",
model_name, ".csv"))
### Create covariate table
covar=covariate_table(
time=covariate_df$times,
L_advanced_2_days=covariate_df$L_advanced_2_days,
F_w_y = covariate_df$F_w_y,
L_orig = covariate_df$L_orig,
w = covariate_df$Week,
y = covariate_df$Year,
times="time"
)
require(foreach)
require(doParallel)
require(deSolve)
#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
cl <- makeCluster(no_cores)
registerDoParallel(cl)
param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)
##load(param_grid)
pd = read.csv(
file = paste0(
"../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/",
model_name,
"_param_grid.csv"
),
header = TRUE
)
head(pd)
midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
seq_len(nrow(param_data_subset_act)),
each = Num_mif_runs_per_start),]
rw_sd_list_default = rw.sd(
M_0 = 0,
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_U = 0,
b_p = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
rw.sd = rw_sd_list_default
detail_log = FALSE
if (detail_log == TRUE) {
detailed_log_file_name = paste0(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
profile_var,
"_Profile/Detailed_Log/log_file_subset_",
param_index,
".txt"
)
write(file = detailed_log_file_name,
paste0("Log generated on ", Sys.time(), " \n"),
append = FALSE)
}
mif_single_subset_data <-
foreach(
i = 1:nrow(param_data_subset),
.combine = rbind,
.packages = c('pomp', 'dplyr'),
.export = c(
"rproc",
"rmeas",
"dmeas",
"init",
"paramnames",
"statenames",
"obsnames",
"param_data_subset",
"par_trans",
"acumvarnames",
"covar"
)
) %dopar%
{
tryCatch({
print(param_data_subset[i,])
print("iter_num")
print(i)
print("param_index")
print(param_index)
params = param_data_subset[i,]
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
seed <- round(runif(1, min = 1, max = 2 ^ 30))
#seed = 565013131
mif_single_param_output <- mif2(
data = small_b_a_single_traj_data,
times = small_b_a_single_traj_data$times,
t0 = t0,
seed = seed,
rproc = pomp::euler(rproc, delta.t = 1),
params = params,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
tol = 0,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
start = params,
Np = 10000,
Nmif = 50,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd
)
first_trace_df = mif_single_param_output@traces %>%
as.data.frame()
first_trace_df$trace_num = seq(1:nrow(first_trace_df))
# trace_df_ll = trace_df %>%
# dplyr::select(loglik, nfail)
# trace_df_no_ll = trace_df %>%
# dplyr::select(-loglik, -nfail)
# trace_df = trace_df_no_ll %>%
# mutate(nfail = trace_df_ll$nfail,
# loglik = trace_df_ll$loglik)
first_trace_df$loglik
first_trace_df$loglist.se = NA
first_trace_df$iter_num = i
first_trace_df$param_index = param_index
first_trace_df$msg = "first_trace"
mif_second_round = mif_single_param_output %>%
mif2(Nmif = 50)
second_trace_df = mif_second_round@traces %>%
as.data.frame()
second_trace_df$trace_num = seq(1:nrow(second_trace_df))
second_trace_df$loglik
second_trace_df$loglist.se = NA
second_trace_df$iter_num = i
second_trace_df$param_index = param_index
second_trace_df$msg = "second_trace"
ll <- tryCatch(
replicate(n = 10, logLik(
pfilter(
data = small_b_a_single_traj_data,
times = small_b_a_single_traj_data$times,
t0 = t0,
rprocess = pomp::euler(rproc, delta.t = 1),
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
format = "data.frame",
Np = 50000,
params = coef(mif_second_round)
)
)),
error = function(e)
e
)
fin = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
if (is(ll, "error")) {
} else{
ll_with_se = logmeanexp(ll, se = TRUE)
if (detail_log == TRUE) {
log_str = paste0(log_str,
"pfilter_warnings: \n ",
warnings(),
" \n Done with warnings \n")
}
}
if (is.na(ll_with_se[[1]])) {
} else{
fin$loglik = ll_with_se[[1]]
fin$loglist.se = ll_with_se[[2]]
}
fin$iter_num = i
fin$param_index = param_index
fin$msg = "mif1"
start_and_trace = bind_rows(start, first_trace_df)
start_and_trace = bind_rows(start_and_trace, second_trace_df)
bind_rows(start_and_trace, fin)
},
error = function (e) {
warning("Inside error function")
print("iter_num")
print(i)
print("param_index")
print(param_index)
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
start$loglik = NA
start$nfail = NA
start$trace_num = NA
start$loglist.se = NA
fin = start
fin$msg = conditionMessage(e)
full_join(start, fin, by = names(start))
})
} -> res
output_name = paste(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
"Sim_Data_Small_b_a_param_Grid_Search_MIF_run_1/",
model_name,
"_Sim_Data_Small_b_a_param_Grid_Search_MIF_run_1_subset_",
param_index,
".RData",
sep = ""
)
if (detail_log == TRUE) {
write(file = detailed_log_file_name, log_output, append = TRUE)
}
save(res, file = output_name)
res
proc.time() - ptmScript to execute code on Midway computing cluster for grid search MIF run (SEIAR) for big b_a simulation trajectory
cat Midway_script_Model_N_12_Simulation_Fit_Big_b_a_Grid_Search_MIF_run_1.sbatch#!/bin/bash
#SBATCH --job-name=Sim_Fit_big_b_a_Grid_Search_MIF_run_1_N_12
#SBATCH --output=Sim_Fit_big_b_a_Grid_Search_MIF_run_1_N_12_%A_%a.out
#SBATCH --error=error_Sim_Fit_big_b_a_Grid_Search_MIF_run_1_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=28
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000
echo $SLURM_ARRAY_TASK_ID
module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args N_12' MIF_run_Model_N_12_sim_data_big_b_a.R OUT_Sim_Fit_Big_b_a_Grid_Search_MIF_run_1/out.$SLURM_ARRAY_TASK_ID Script to execute code on Midway computing cluster for grid search MIF run (SEIAR) for small b_a simulation trajectory
cat Midway_script_Model_N_12_Simulation_Fit_Small_b_a_Grid_Search_MIF_run_1.sbatch#!/bin/bash
#SBATCH --job-name=Sim_Fit_small_b_a_Grid_Search_MIF_run_1_N_12
#SBATCH --output=Sim_Fit_small_b_a_Grid_Search_MIF_run_1_N_12_%A_%a.out
#SBATCH --error=error_Sim_Fit_small_b_a_Grid_Search_MIF_run_1_N_12_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=28
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000
echo $SLURM_ARRAY_TASK_ID
module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args N_12' MIF_run_Model_N_12_sim_data_small_b_a.R OUT_Sim_Fit_Small_b_a_Grid_Search_MIF_run_1/out.$SLURM_ARRAY_TASK_ID Code to generate profile combinations for b_a profile (SEPIAR) for big b_a simulation trajectory
knitr::read_chunk('generate_profile_combinations_covid_nyc_N_12_Sim_data_Big_b_a_param.R')# Header ------------------------------------------------------------------
## Name: generate_profile_combinations_covid_NYC_N_12_Sim_data_Big_b_a_param.R
## Author: Rahul Subramanian
## Description: Creates 30*40-combination list for given by profile_var as 1st command line argument
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
library(stringr)
args = commandArgs(trailingOnly=TRUE)
#model_name = "N_12"
#profile_var = "b_a"
profile_var = as.character(args[1])
print(profile_var)
model_name = as.character(args[2])
print(model_name)
#Load box
top_20_LL_box = read.csv(
file = paste0("../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/Sim_Data_Big_b_a_param_original_20_LL_param_box_from_1st_MIF_run.csv"))
#Modify G_w_y_scaling box boundaries
par_box_boundaries = top_20_LL_box %>%
dplyr::select(-msg, -iter_num, -param_index, -loglik, -nfail, -trace_num,
-loglist.se)
if(profile_var == "G_w_y_scaling"){
par_box_boundaries$G_w_y_scaling = c(0,0.33)
}else{
if(profile_var == 'b_a'){
par_box_boundaries$b_a = c(0,1)
par_box_boundaries$b_p = c(0,1)
}else{
}
}
par_box_boundaries_clean = dplyr::select(par_box_boundaries, -one_of(profile_var) )
theta.t.lo = as.numeric(as.vector(par_box_boundaries_clean[1,]))
theta.t.hi = as.numeric(as.vector(par_box_boundaries_clean[2,]))
names(theta.t.lo) = colnames(par_box_boundaries_clean)
names(theta.t.hi) = colnames(par_box_boundaries_clean)
prof_var_boundaries = dplyr::select(par_box_boundaries, one_of(profile_var))
profileDesign(
prof_var=seq(from=prof_var_boundaries[1,],to=prof_var_boundaries[2,],length=30),
lower=theta.t.lo,upper=theta.t.hi,nprof=40
) -> pd
pd_col = colnames(pd)
colnames(pd) = c(profile_var, pd_col[2:length(pd_col)])
write.csv(pd, file = paste0("../Generated_Data/Profile_Combination_Lists/",
model_name,"_Model/", profile_var,"_",
model_name,
"_Sim_Data_Big_b_a_param_profile_combination_list.csv"),
append = FALSE, row.names = FALSE)
proc.time() - ptmCode to generate profile combinations for b_a profile (SEPIAR) for small b_a simulation trajectory
knitr::read_chunk('generate_profile_combinations_covid_nyc_N_12_Sim_data_Small_b_a_param.R')# Header ------------------------------------------------------------------
## Name: generate_profile_combinations_covid_NYC_N_12_Sim_data_Small_b_a_param.R
## Author: Rahul Subramanian
## Description: Creates 30*40-combination list for given by profile_var as 1st command line argument
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
library(stringr)
args = commandArgs(trailingOnly=TRUE)
#model_name = "N_12"
#profile_var = "b_a"
profile_var = as.character(args[1])
print(profile_var)
model_name = as.character(args[2])
print(model_name)
#Load box
top_20_LL_box = read.csv(
file = paste0("../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/Sim_Data_Small_b_a_param_original_20_LL_param_box_from_1st_MIF_run.csv"))
#Modify G_w_y_scaling box boundaries
par_box_boundaries = top_20_LL_box %>%
dplyr::select(-msg, -iter_num, -param_index, -loglik, -nfail, -trace_num,
-loglist.se)
if(profile_var == "G_w_y_scaling"){
par_box_boundaries$G_w_y_scaling = c(0,0.33)
}else{
if(profile_var == 'b_a'){
par_box_boundaries$b_a = c(0,1)
par_box_boundaries$b_p = c(0,1)
}else{
}
}
par_box_boundaries_clean = dplyr::select(par_box_boundaries, -one_of(profile_var) )
theta.t.lo = as.numeric(as.vector(par_box_boundaries_clean[1,]))
theta.t.hi = as.numeric(as.vector(par_box_boundaries_clean[2,]))
names(theta.t.lo) = colnames(par_box_boundaries_clean)
names(theta.t.hi) = colnames(par_box_boundaries_clean)
prof_var_boundaries = dplyr::select(par_box_boundaries, one_of(profile_var))
profileDesign(
prof_var=seq(from=prof_var_boundaries[1,],to=prof_var_boundaries[2,],length=30),
lower=theta.t.lo,upper=theta.t.hi,nprof=40
) -> pd
pd_col = colnames(pd)
colnames(pd) = c(profile_var, pd_col[2:length(pd_col)])
write.csv(pd, file = paste0("../Generated_Data/Profile_Combination_Lists/",
model_name,"_Model/", profile_var,"_",
model_name,
"_Sim_Data_Small_b_a_param_profile_combination_list.csv"),
append = FALSE, row.names = FALSE)
proc.time() - ptmCode to run MIF for b_a profile (SEPIAR) for big b_a simulation trajectory
knitr::read_chunk('MIF_run_Profile_Model_N_12_sim_data_big_b_a.R')# Header ------------------------------------------------------------------
## Name: MIF_run_profile_Model_N_12_sim_data_big_b_a.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
profile_var = as.character(args[1])
print(profile_var)
model_name = as.character(args[2])
print(model_name)
#model_name = "N_12"
#profile_var = "b_a"
#param_index = 1
#i = 1
#Load simulated trajectory from big b_a parameter combination
big_b_a_single_traj_data = read.csv(
"../Generated_Data/Representative_Simulations/big_b_a_single_sim_traj_data.csv")
head(big_b_a_single_traj_data)
### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")
## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14
#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")
## Load NYC covariate data
covariate_df = read.csv(file =
paste0("../Generated_Data/covariate_data_",
model_name, ".csv"))
### Create covariate table
covar=covariate_table(
time=covariate_df$times,
L_advanced_2_days=covariate_df$L_advanced_2_days,
F_w_y = covariate_df$F_w_y,
L_orig = covariate_df$L_orig,
w = covariate_df$Week,
y = covariate_df$Year,
times="time"
)
require(foreach)
require(doParallel)
require(deSolve)
#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
assinged_cores = 1
cat("assinged_cores = ", assinged_cores, "\n")
cl <- makeCluster(assinged_cores, outfile="")
registerDoParallel(cl)
param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)
##load(param_grid)
pd = read.csv(
file = paste0(
"../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/",
profile_var,
"_",
model_name,
"_Sim_Data_Big_b_a_param_profile_combination_list.csv"
),
header = TRUE
)
head(pd)
midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
seq_len(nrow(param_data_subset_act)),
each = Num_mif_runs_per_start),]
rw_sd_list_default = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
get_rwsd = function(profile_var){
if(profile_var == "G_w_y_scaling"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0,
M_0 = 0,
phi_U = 0)
}else{
if(profile_var == "R_0"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02,
M_0 = 0,
phi_U = 0,)
}else{
if(profile_var == "b_a"){
rw.sd = rw.sd(
M_0 = 0,
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_U = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
b_p = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
}else{
if(profile_var == "p_S"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0,
p_H_cond_S = 0.02,
b_p = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "p_H_cond_S"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
b_p = 0.02,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "E_0"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "z_0"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
b_p = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "gamma"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
b_p = 0.02,
gamma = 0,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "b_q"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
b_p = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
stop("Profile var not specified in rwsd wrapper function")
}
}
}
}
}
}
}
}
}
}
rw.sd = get_rwsd(profile_var = profile_var)
detail_log = FALSE
if (detail_log == TRUE) {
detailed_log_file_name = paste0(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
profile_var,
"_Profile/Detailed_Log/log_file_subset_",
param_index,
".txt"
)
write(file = detailed_log_file_name,
paste0("Log generated on ", Sys.time(), " \n"),
append = FALSE)
}
mif_single_subset_data <-
foreach(
i = 1:nrow(param_data_subset),
.combine = rbind,
.packages = c('pomp', 'dplyr'),
.export = c(
"rproc",
"rmeas",
"dmeas",
"init",
"paramnames",
"statenames",
"obsnames",
"param_data_subset",
"par_trans",
"acumvarnames",
"covar"
)
) %dopar%
{
tryCatch({
print(param_data_subset[i,])
print("iter_num")
print(i)
print("param_index")
print(param_index)
params = param_data_subset[i,]
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
seed <- round(runif(1, min = 1, max = 2 ^ 30))
#seed = 565013131
mif_single_param_output <- mif2(
data = big_b_a_single_traj_data,
times = big_b_a_single_traj_data$times,
t0 = t0,
seed = seed,
rproc = pomp::euler(rproc, delta.t = 1),
params = params,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
tol = 0,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
start = params,
Np = 10000,
Nmif = 50,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd
)
first_trace_df = mif_single_param_output@traces %>%
as.data.frame()
first_trace_df$trace_num = seq(1:nrow(first_trace_df))
# trace_df_ll = trace_df %>%
# dplyr::select(loglik, nfail)
# trace_df_no_ll = trace_df %>%
# dplyr::select(-loglik, -nfail)
# trace_df = trace_df_no_ll %>%
# mutate(nfail = trace_df_ll$nfail,
# loglik = trace_df_ll$loglik)
first_trace_df$loglik
first_trace_df$loglist.se = NA
first_trace_df$iter_num = i
first_trace_df$param_index = param_index
first_trace_df$msg = "first_trace"
mif_second_round = mif_single_param_output %>%
mif2(Nmif = 50)
second_trace_df = mif_second_round@traces %>%
as.data.frame()
second_trace_df$trace_num = seq(1:nrow(second_trace_df))
second_trace_df$loglik
second_trace_df$loglist.se = NA
second_trace_df$iter_num = i
second_trace_df$param_index = param_index
second_trace_df$msg = "second_trace"
ll <- tryCatch(
replicate(n = 10, logLik(
pfilter(
data = big_b_a_single_traj_data,
times = big_b_a_single_traj_data$times,
t0 = t0,
rprocess = pomp::euler(rproc, delta.t = 1),
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
format = "data.frame",
Np = 50000,
params = coef(mif_second_round)
)
)),
error = function(e)
e
)
fin = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
if (is(ll, "error")) {
} else{
ll_with_se = logmeanexp(ll, se = TRUE)
if (detail_log == TRUE) {
log_str = paste0(log_str,
"pfilter_warnings: \n ",
warnings(),
" \n Done with warnings \n")
}
}
if (is.na(ll_with_se[[1]])) {
} else{
fin$loglik = ll_with_se[[1]]
fin$loglist.se = ll_with_se[[2]]
}
fin$iter_num = i
fin$param_index = param_index
fin$msg = "mif1"
start_and_trace = bind_rows(start, first_trace_df)
start_and_trace = bind_rows(start_and_trace, second_trace_df)
bind_rows(start_and_trace, fin)
},
error = function (e) {
warning("Inside error function")
print("iter_num")
print(i)
print("param_index")
print(param_index)
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
start$loglik = NA
start$nfail = NA
start$trace_num = NA
start$loglist.se = NA
fin = start
fin$msg = conditionMessage(e)
full_join(start, fin, by = names(start))
})
} -> res
output_name = paste(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
profile_var,
"_Profile_Sim_Data_Big_b_a_param/Subset_Outputs/",
profile_var,
"_",
model_name,
"_Profile_Sim_Data_Big_b_a_param_subset_",
param_index,
".RData",
sep = ""
)
if (detail_log == TRUE) {
write(file = detailed_log_file_name, log_output, append = TRUE)
}
save(res, file = output_name)
res
proc.time() - ptmCode to run MIF for b_a profile (SEPIAR) for small b_a simulation trajectory
knitr::read_chunk('MIF_run_Profile_Model_N_12_sim_data_small_b_a.R')# Header ------------------------------------------------------------------
## Name: MIF_run_Model_N_12_sim_data_small_b_a.R
## Author: Rahul Subramanian
## Description: Runs parameter combinations on midway for profile from original param grid
## for Model N_12
rm(list = ls())
ptm <- proc.time()
#Load Libraries
source("load_libraries_essential.R")
source("rahul_theme.R")
library(pomp)
args = commandArgs(trailingOnly = TRUE)
#param_index = as.numeric(args[1]) + as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
profile_var = as.character(args[1])
print(profile_var)
model_name = as.character(args[2])
print(model_name)
#model_name = "N_12"
#profile_var = "b_a"
#param_index = 1
#i = 1
#Load simulated trajectory from small b_a parameter combination
small_b_a_single_traj_data = read.csv(
"../Generated_Data/Representative_Simulations/small_b_a_single_sim_traj_data.csv")
head(small_b_a_single_traj_data)
### Define start date
true_start_date = as.Date("2020-03-01")
t0 = 0
start_of_year = as.Date("2020-01-01")
first_saturday_in_year = as.Date("2020-01-04")
## Compartment/Queue Cohort Numbers
M = 5
V = 13
K = 14
#Declare Csnippets and data
source("Csnippet_nyc_coronavirus_model_N_12.R")
## Load NYC covariate data
covariate_df = read.csv(file =
paste0("../Generated_Data/covariate_data_",
model_name, ".csv"))
### Create covariate table
covar=covariate_table(
time=covariate_df$times,
L_advanced_2_days=covariate_df$L_advanced_2_days,
F_w_y = covariate_df$F_w_y,
L_orig = covariate_df$L_orig,
w = covariate_df$Week,
y = covariate_df$Year,
times="time"
)
require(foreach)
require(doParallel)
require(deSolve)
#Core management
no_cores <- detectCores()
cat("no_cores = ", no_cores, "\n")
assinged_cores = 1
cat("assinged_cores = ", assinged_cores, "\n")
cl <- makeCluster(assinged_cores, outfile="")
registerDoParallel(cl)
param_index = as.numeric(Sys.getenv("SLURM_ARRAY_TASK_ID"))
print("param_index")
print(param_index)
##load(param_grid)
pd = read.csv(
file = paste0(
"../Generated_Data/Profile_Combination_Lists/",
model_name,
"_Model/",
profile_var,
"_",
model_name,
"_Sim_Data_Small_b_a_param_profile_combination_list.csv"
),
header = TRUE
)
head(pd)
midway_max_jobs = 500
group_size = nrow(pd) / midway_max_jobs
start_index = (param_index - 1) * group_size + 1
end_index = param_index * group_size
Num_mif_runs_per_start = 1
param_data_subset_act = pd[start_index:end_index,]
param_data_subset = param_data_subset_act[rep(
seq_len(nrow(param_data_subset_act)),
each = Num_mif_runs_per_start),]
rw_sd_list_default = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
get_rwsd = function(profile_var){
if(profile_var == "G_w_y_scaling"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0,
M_0 = 0,
phi_U = 0)
}else{
if(profile_var == "R_0"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02,
M_0 = 0,
phi_U = 0,)
}else{
if(profile_var == "b_a"){
rw.sd = rw.sd(
M_0 = 0,
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_U = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
b_p = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0)
}else{
if(profile_var == "p_S"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0,
p_H_cond_S = 0.02,
b_p = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "p_H_cond_S"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
b_p = 0.02,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "E_0"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
b_p = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "z_0"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
b_p = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "gamma"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
b_p = 0.02,
gamma = 0,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0.02,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
if(profile_var == "b_q"){
rw.sd = rw.sd(
V_0 = 0,
K_0 = 0,
phi_E = 0,
phi_S = 0,
h_V = 0,
p_S = 0.02,
p_H_cond_S = 0.02,
gamma = 0.02,
b_p = 0.02,
social_distancing_start_time = 0,
quarantine_start_time = 0,
z_0 = ivp(0.02),
E_0 = ivp(0.02),
N_0 = ivp(0),
C_0 = ivp(0),
PCR_sens = 0,
b_q = 0,
b_a = 0.02,
R_0 = 0.02,
sigma_M = 0.02,
beta_w_3 = 0,
beta_w_2 = 0,
beta_w_1 = 0,
beta_w_0 = 0,
g_0 = 0,
g_F = 0,
sigma_epsilon = 0,
G_w_y_scaling = 0.02)
}else{
stop("Profile var not specified in rwsd wrapper function")
}
}
}
}
}
}
}
}
}
}
rw.sd = get_rwsd(profile_var = profile_var)
detail_log = FALSE
if (detail_log == TRUE) {
detailed_log_file_name = paste0(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
profile_var,
"_Profile/Detailed_Log/log_file_subset_",
param_index,
".txt"
)
write(file = detailed_log_file_name,
paste0("Log generated on ", Sys.time(), " \n"),
append = FALSE)
}
mif_single_subset_data <-
foreach(
i = 1:nrow(param_data_subset),
.combine = rbind,
.packages = c('pomp', 'dplyr'),
.export = c(
"rproc",
"rmeas",
"dmeas",
"init",
"paramnames",
"statenames",
"obsnames",
"param_data_subset",
"par_trans",
"acumvarnames",
"covar"
)
) %dopar%
{
tryCatch({
print(param_data_subset[i,])
print("iter_num")
print(i)
print("param_index")
print(param_index)
params = param_data_subset[i,]
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
seed <- round(runif(1, min = 1, max = 2 ^ 30))
#seed = 565013131
mif_single_param_output <- mif2(
data = small_b_a_single_traj_data,
times = small_b_a_single_traj_data$times,
t0 = t0,
seed = seed,
rproc = pomp::euler(rproc, delta.t = 1),
params = params,
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
tol = 0,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
start = params,
Np = 10000,
Nmif = 50,
cooling.fraction.50 = 0.5,
rw.sd = rw.sd
)
first_trace_df = mif_single_param_output@traces %>%
as.data.frame()
first_trace_df$trace_num = seq(1:nrow(first_trace_df))
# trace_df_ll = trace_df %>%
# dplyr::select(loglik, nfail)
# trace_df_no_ll = trace_df %>%
# dplyr::select(-loglik, -nfail)
# trace_df = trace_df_no_ll %>%
# mutate(nfail = trace_df_ll$nfail,
# loglik = trace_df_ll$loglik)
first_trace_df$loglik
first_trace_df$loglist.se = NA
first_trace_df$iter_num = i
first_trace_df$param_index = param_index
first_trace_df$msg = "first_trace"
mif_second_round = mif_single_param_output %>%
mif2(Nmif = 50)
second_trace_df = mif_second_round@traces %>%
as.data.frame()
second_trace_df$trace_num = seq(1:nrow(second_trace_df))
second_trace_df$loglik
second_trace_df$loglist.se = NA
second_trace_df$iter_num = i
second_trace_df$param_index = param_index
second_trace_df$msg = "second_trace"
ll <- tryCatch(
replicate(n = 10, logLik(
pfilter(
data = small_b_a_single_traj_data,
times = small_b_a_single_traj_data$times,
t0 = t0,
rprocess = pomp::euler(rproc, delta.t = 1),
paramnames = paramnames,
statenames = statenames,
obsnames = obsnames,
dmeas = dmeas,
accumvars = acumvarnames,
rinit = init,
rmeas = rmeas,
partrans = par_trans,
covar = covar,
format = "data.frame",
Np = 50000,
params = coef(mif_second_round)
)
)),
error = function(e)
e
)
fin = mif_second_round %>% coef() %>% rbind() %>% as.data.frame()
if (is(ll, "error")) {
} else{
ll_with_se = logmeanexp(ll, se = TRUE)
if (detail_log == TRUE) {
log_str = paste0(log_str,
"pfilter_warnings: \n ",
warnings(),
" \n Done with warnings \n")
}
}
if (is.na(ll_with_se[[1]])) {
} else{
fin$loglik = ll_with_se[[1]]
fin$loglist.se = ll_with_se[[2]]
}
fin$iter_num = i
fin$param_index = param_index
fin$msg = "mif1"
start_and_trace = bind_rows(start, first_trace_df)
start_and_trace = bind_rows(start_and_trace, second_trace_df)
bind_rows(start_and_trace, fin)
},
error = function (e) {
warning("Inside error function")
print("iter_num")
print(i)
print("param_index")
print(param_index)
start = param_data_subset[i,]
start$msg = "start"
start$iter_num = i
start$param_index = param_index
start$loglik = NA
start$nfail = NA
start$trace_num = NA
start$loglist.se = NA
fin = start
fin$msg = conditionMessage(e)
full_join(start, fin, by = names(start))
})
} -> res
output_name = paste(
"../Generated_Data/Profiles/",
model_name,
"_Model/",
profile_var,
"_Profile_Sim_Data_Small_b_a_param/Subset_Outputs/",
profile_var,
"_",
model_name,
"_Profile_Sim_Data_Small_b_a_param_subset_",
param_index,
".RData",
sep = ""
)
if (detail_log == TRUE) {
write(file = detailed_log_file_name, log_output, append = TRUE)
}
save(res, file = output_name)
res
proc.time() - ptmScript to execute code on Midway computing cluster for b_a profile MIF run (SEPIAR) for big b_a simulation trajectory
cat Midway_script_Model_N_12_b_a_Profile_Sim_data_big_b_a_param.sbatch#!/bin/bash
#SBATCH --job-name=b_a_N_12_Sim_data_big_b_a_param
#SBATCH --output=b_a_N_12_Sim_data_big_b_a_param_%A_%a.out
#SBATCH --error=error_b_a_N_12_Sim_data_big_b_a_param_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=1
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000
echo $SLURM_ARRAY_TASK_ID
module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args b_a N_12' MIF_run_Profile_Model_N_12_sim_data_big_b_a.R OUT_b_a_Sim_Data_big_b_a_param/out.$SLURM_ARRAY_TASK_ID Script to execute code on Midway computing cluster for b_a profile MIF run (SEPIAR) for small b_a simulation trajectory
cat Midway_script_Model_N_12_b_a_Profile_Sim_data_small_b_a_param.sbatch#!/bin/bash
#SBATCH --job-name=b_a_N_12_Sim_data_small_b_a_param
#SBATCH --output=b_a_N_12_Sim_data_small_b_a_param_%A_%a.out
#SBATCH --error=error_b_a_N_12_Sim_data_small_b_a_param_%A_%a.err
#SBATCH --array=1-500
#SBATCH --partition=broadwl
#SBATCH --account=covid-19
#SBATCH --qos=covid-19
#SBATCH --nodes=1
#SBATCH --ntasks-per-node=1
#SBATCH --mem-per-cpu=2000
#SBATCH --cpus-per-task=1
#SBATCH --mem-per-cpu=2000
echo $SLURM_ARRAY_TASK_ID
module load gcc
module load R/3.5.1
R CMD BATCH --vanilla '--args b_a N_12' MIF_run_Profile_Model_N_12_sim_data_small_b_a.R OUT_b_a_Sim_Data_small_b_a_param/out.$SLURM_ARRAY_TASK_ID